perm filename CBE[REC,DBL] blob
sn#122246 filedate 1974-09-26 generic text, type T, neo UTF8
(FILECREATED "26-SEP-74 18:22:48" CBE.;2 97710
changes to: ASK:USER:ABOUT CLARIFY:IMPROBABLE:SITUATION ENCODE SATISFY SUPPORT&DUMP
previous date: "22-SEP-74 16:17:39" CBE.;1)
(LISPXPRINT (QUOTE CBECOMS)
T)
(RPAQQ CBECOMS
((FNS ADD:DEFINITION ADJECTIVE:HANDLER ANALYZE:IMPLICATIONS APPLYRULE ASK:USER:ABOUT BETTER CHOOSE:FROM
CLARIFY:IMPROBABLE:SITUATION CLASSIFICATORY:CONCEPT:FORMATION COMPARE COMPARITIVE:CONCEPT:FORMATION
COMPLEX:ALTERATION CONDITIONAL:DELETION CONDITIONAL:INSERTION CONSTRAIN DATA:STRUCTURE:DELETIONS
DATA:STRUCTURE:INSERTIONS DEFER:DECISION ENCODE EXAMINE:STRUCTURE EXTRACT:RELEVANT:SUBSET FAST:GET:NAME
FAST:SATISFY FILL:IN:UNDEFINED:SECTION FOREACH GET:DATA:STRUCTURE GET:HOLD:OF GET:NAME
GET:NEW:INFORMATION IS:OF:TYPE JOINING:FUNCTION LIST:STRUCTURE MAKE:A:GUESS MAKE:ENCODABLE
MAKE:NEW:BEING MESSAGE METRICAL:CONCEPT:FORMATION MODIFY:STRUCTURE OBTAIN:USABLE:INFORMATION
PARTITION:A:DOMAIN PARTITION:BY:TAKE:CLASS:GET:ELE PARTITION:BY:TAKE:ELE:AND:CLASS
PARTITION:BY:TAKE:ELE:GET:CLASS PATTERN:MATCH PROBABILITY=0:# PROBABILITY=1:# PROBABILITY>0&<1:#
PROPOSE:PLAUSIBLE:NAMES REINVESTIGATE:DECISION REPEATEDLY RESOLVE:DECISION SATISFY SCENE SEARCH SERVE
SIMPLE:COMPARE:FN STUDY:TYPE SUPPORT&DUMP TRANSLATE USE:INFORMATION UTILIZE WHEN:NEXT WRITE:PROGRAM)
FNSCOMP
(P (MAPC (SETDIFFERENCE SET:OF:BEINGS FNSCOMP)
SEMI:COMPILE))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML GET:HOLD:OF FOREACH CONSTRAIN))))
)
(DEFINEQ
(ADD:DEFINITION
(LAMBDA (OBJECT DEFINITION FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS ADD:DEFINITION BEING:STACK))
(ATOM OBJECT)
(PUT ADD:DEFINITION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ ENCODABLE:SECTION:LIST (CONS OBJECT ENCODABLE:SECTION:LIST))
(SETQ TYPE:OF:LIST (MAPCAR TYPE:OF:LIST (FUNCTION (LAMBDA (TOL)
(COND
((MATCH (VECTOR (@ OBJECT)
TYPE OF ANY1 IS FRAG1 USED
IN ANY2)
TOL)
(VECTOR (@ OBJECT)
TYPE OF (@ ANY1)
IS
(@ DEFINITION) AND IS USED
IN (@ ANY2)))
(T TOL))))))
(SETQ IS:DEFINED:LIST (NCONC1 IS:DEFINED:LIST (VECTOR (@ OBJECT)
IS
(@ DEFINITION))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(ADJECTIVE:HANDLER
(LAMBDA (ADJ NOUN:GROUP TNAME BNAME CODE TCODE MCODE FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS ADJECTIVE:HANDLER BEING:STACK))
(MEMBER ADJ ADJECTIVES)
(SATISFY (VECTOR NAMED EXPRESSION (INVECTOR (OUTTUPLE (CONS ADJ NOUN:GROUP)))
(SETQQ TNAME TNAME)))
(SET TNAME TNAME)
(PUT ADJECTIVE:HANDLER SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ FARGS NIL)
(SETQ BNAME (CAR (LAST NOUN:GROUP)))
(SETQ MCODE (GETP BNAME META:CODE))
(SETQ CODE (COND
((SETQ TCODE (SASSOC (OPPOSITE ADJ)
MCODE))
(PROCEDURE:PULLOUT TCODE MCODE))
((SETQ TCODE (SASSOC ADJ MCODE))
(CONS (CAR MCODE)
(CDR TCODE)))
(T MCODE)))))
(SATISFY (VECTOR IS BEING (@ TNAME)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(ANALYZE:IMPLICATIONS
(LAMBDA (NEW:INFO A:A P:A FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS ANALYZE:IMPLICATIONS BEING:STACK))
(OR (NULL RELEVANT:INFO:LIST)
(MEMBER NEW:INFO RELEVANT:INFO:LIST))
(PUT ANALYZE:IMPLICATIONS SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ A:A (LOCATE:AFFECTED:AREA NEW:INFO))
(COND
(A:A (SETQ P:A (PREDICT:AFFECT A:A NEW:INFO))
(EVALUATE:AFFECT P:A A:A)))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(APPLYRULE
(LAMBDA (ARG1 ARG2 STRNG FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS APPLYRULE BEING:STACK))
(PUT APPLYRULE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN ARG1
(COMMENT THIS APPEARANCE OF ARG1 IS SIMPLY
TO ENSURE THAT A COMMENT ABOUT ITS BINDING GETS STUCK IN HERE SOMEWHERE IN THE META:CODE)
(ALLSUBSTS (COPY (EVAL (GETP RULE RIGHT:SIDE)))
(COPY (EVAL (GETP RULE LEFT:SIDE)))
(COPY ARG2))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(ASK:USER:ABOUT
(LAMBDA (D DTYPE IN:SET IN:SET:TRANS TEMPFNVAL FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS ASK:USER:ABOUT BEING:STACK))
(PUT ASK:USER:ABOUT SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (DETERMINE:ARG:VALUE CHOICE)
(DETERMINE:ARG2:VALUE CHOICE)
(TERPRI)
(TERPRI)
(PUPRIN1 "
MOVE CURSOR TO ")
(PUPRINT CHOICE)
(SETQ DTYPE (CADADR D))
(TERPRI)
(TERPRI)
(PUPRIN1 "PUP: SORRY TO BOTHER YOU, BUT I CAN NO LONGER DEFER THIS ")
(PUPRIN1 DTYPE)
(PUPRIN1 " DECISION:")
(PUPRINT (CDAR (CDDADR D)))
(COND
((MEMBER (CADR CHOICE)
ENCODABLE:SECTION:LIST))
(T (SETQ TEMPFNVAL (EVAL (EVAL (COLON:BACK (LIST DTYPE (CADR BEING:STACK)
KNOWLEDGE)))))
(COND
((STRINGP TEMPFNVAL)
T)
(T TEMPFNVAL))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(BETTER
(LAMBDA (B1 B2 B1NEW B2NEW WHEN:DIFF RESULT1 FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS BETTER BEING:STACK))
(AND (EQUAL T (GETP (CAR B1)
BEING))
(EQUAL T (GETP (CAR B2)
BEING)))
(PUT BETTER SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ B1NEW B1)
(SETQ B2NEW B2)
(SETQ B1NEW (CONS (CAR B1NEW)
(MAPCAR (CDR B1NEW)
EVAL)))
(SETQ B2NEW (CONS (CAR B2NEW)
(MAPCAR (CDR B2NEW)
EVAL)))
(SETQ WHEN:DIFF (DIFFERENCE (WHEN:VALUE B1NEW)
(WHEN:VALUE B2NEW)))
(COND
((EQP WHEN:DIFF 0)
(SETQ RESULT1 (A:BEING:ORDER (CAR B1NEW)
(CAR B2NEW)))
(SETQ BECAUSE (APPEND BECAUSE (TUPLE THE WHEN PARTS
OF (@ (CAR B1NEW))
AND (@ (CAR B2NEW))
ARE EQUAL
AND
THE FORMER IS
(@ (COND
(RESULT1 (QUOTE LESS))
(T (QUOTE MORE))))
COMPLEX THAN THE LATTER
BEING))))
(T (SETQ RESULT1 (NOT (MINUSP WHEN:DIFF)))
(SETQ BECAUSE (APPEND BECAUSE (TUPLE THE WHEN PART
OF THE (@ (CAR B1NEW))
IS
(@ (COND
(RESULT1 SUPERIOR)
(T INFERIOR)))
TO THE WHEN PART
OF (@ (CAR B2NEW)))))))
RESULT1))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(CHOOSE:FROM
(LAMBDA (S EXP:TEST TEMPBB FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS CHOOSE:FROM BEING:STACK))
(PROGN (SETQ EXP:TEST T)
(MAPC S (FUNCTION (LAMBDA (S1)
(COND
((NOT (EQUAL T (GETP (CAR S1)
BEING)))
(SETQ EXP:TEST NIL))))))
(COND
(EXP:TEST)
((EQUAL USER:WARNING:LIST (SETQ USER:WARNING:LIST
(SETUNION USER:WARNING:LIST (LIST (VECTOR WARNING, WARNING; NOT ALL
OF (MAPCAR S (QUOTE CAR))
ARE BEINGS))))))
(T (PUPRINT (CAR (LAST USER:WARNING:LIST))))))
(PUT CHOOSE:FROM SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG (BEST)
(SETQ BEST (CAR S))
(SETQ BECAUSE (VECTOR WE MUST SELECT THE BEST BEING
FROM (INVECTOR (MAPCAR S (QUOTE CAR)))))
(COND
((SINGLETON S)
(SETQ BECAUSE (APPEND BECAUSE (VECTOR AND, TRIVIALLY, (INVECTOR (CAR S))
IS OUR ONLY CHOICE))))
(T (MAPC (CDR S)
(FUNCTION (LAMBDA (S1)
(COND
((EQUAL T (BETTER S1 BEST))
(SETQ BEST S1))))))))
(SETQ BECAUSE (VECTOR NOW THAT WE HAVE SELECTED (CAR BEST)
AS THE BEST BEING OUT OF THE SET (MAPCAR S (QUOTE CAR))
WE MUST CARRY OUT (INVECTOR BEST)))
(COND
((SETQ TEMPBB (EVAL BEST))
(SETQ UNKNOWN:TASK TEMPBB))
((CDR S)
(CHOOSE:FROM (PULLOUT BEST S))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(CLARIFY:IMPROBABLE:SITUATION
(LAMBDA (U WHAT:WE:DID RESPONSE GD1 GD2 L1 L2 L3 EA EAM SPANY2 BC B:META:CODE WHOLE:CHOICE H1 H2 H3 TCHOICE IXS AN2
AN1 GC2 AN3 IV ANY1:COPY HAN1 HAN2 HAN3 FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS CLARIFY:IMPROBABLE:SITUATION BEING:STACK))
(COND
((SOME CODING:WARNING:LIST (FUNCTION (LAMBDA (CWL)
(LESSP (IMPROBABILITY:COMPLEX CWL)
500)))))
((NULL (CDR CODING:WARNING:LIST)))
(T (SETQ CODING:WARNING:LIST (MAPCAR CODING:WARNING:LIST (FUNCTION (LAMBDA (COWL)
(CONS (TIMES .8 (IMPROBABILITY:COMPLEX COWL))
(CDR COWL))))))
NIL))
(SETQ WHOLE:CHOICE (TRUE:MINIMUM CODING:WARNING:LIST IMPROBABILITY:COMPLEX))
(SETQ CHOICE (CDR WHOLE:CHOICE))
(SETQ DOING:PUP:LIST (CONS (VECTOR IMPROBABILITY (INVECTOR CHOICE))
DOING:PUP:LIST))
(PUT CLARIFY:IMPROBABLE:SITUATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(SETQ WHAT:WE:DID
(COND
((MATCH (VECTOR IN ALL CODE GENERATED, ANY1 SHOULD BE REPLACED BY ANY2)
CHOICE)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(MAPC ASSERT:LISTS (FUNCTION (LAMBDA (AL)
(SET AL (DSUBST ANY2 ANY1 (EVAL AL))))))
(MAPC
(SETDIFFERENCE IS:BEING:LIST SET:OF:BEINGS)
(FUNCTION (LAMBDA (B)
(AND (EQUAL (CAR ANY2)
(QUOTE APPEND))
(NOT (LISTP ANY1))
(EQUAL (CAR (SETQ B:META:CODE (GETP B META:CODE)))
STRUCTURE)
(MEMBER ANY1 (FLATTEN B:META:CODE))
(PUT B META:CODE (MAPCONC B:META:CODE (FUNCTION (LAMBDA (PIECE:OF:CODE)
(COND
((NOT (EQUAL ANY1 (CADDR PIECE:OF:CODE)))
(LIST PIECE:OF:CODE))
((MAPCAR (CDR ANY2)
(FUNCTION (LAMBDA (SUBPIECE:OF:CODE)
(SUBST SUBPIECE:OF:CODE ANY1 PIECE:OF:CODE))))))
)))))
(SETQ SPANY2 (COND
((SETQ EAM (MEMBER ANY1 (SETQ EA (GETP B EXPLICIT:ARGS))))
(PACK (TUPLE ARG:(ADD1 (DIFFERENCE (LENGTH EA)
(LENGTH EAM))))))
(T ANY2)))
(MAPC SET:OF:BEING:PARTS (FUNCTION (LAMBDA (P)
(COND
((GETP B P)
(PUT B P (DSUBST SPANY2 ANY1 (GETP B P))))))))
(AND
(SETQ L1 (CADR (SETQ BC (GETP B META:CODE))))
(MATCH (COMMENT IN ALL CALLS TO DATE, ARG1 IS INSTANTIATED AS ANY3)
L1)
(EQUAL STRUCTURE (CAR (GETP ANY3 META:CODE)))
(SETQ L2 (MAPCAR (CDR (GETP ANY3 META:CODE))
(QUOTE CADDR)))
(SETQ L3 (SETINTERSECTION L2 ANY2))
(PUT
B META:CODE
(APPEND
(LIST (CAR BC)
(CADR BC))
(COND
((AND (SETQ P1TEMP (MAPCAR (CDADR (MEMBER (QUOTE ACCESS)
(GETP ANY3 DATA:STRUCTURE)))
(FUNCTION (LAMBDA (ACC)
(TUPLE SETQ (CAR (LAST ACC))
(CADR ACC))))))
(NOT (INSIDE (QUOTE ACCESSES)
P1TEMP)))
P1TEMP)
(T (SETQ CODING:WARNING:LIST
(CONS (TUPLE 100 VECTOR COMMAND
IF (TUPLE AND (TUPLE LISTP (TUPLE SETQ T63 (TUPLE GETP (@ ANY3)
DATA:STRUCTURE)))
(TUPLE SETQ T64 (TUPLE CDADR (TUPLE MEMBER (TUPLE QUOTE
ACCESS)
(TUPLE GETP (@ ANY3)
DATA:STRUCTURE))))
(TUPLE SETQ T65
(TUPLE EVERY T64
(TUPLE FUNCTION
(TUPLE LAMBDA (TUPLE AC1)
(TUPLE ATOM (TUPLE CAR
(TUPLE LAST
AC1)))))
)))
(TUPLE PUT (@ B)
META:CODE
(TUPLE SUBST (TUPLE APPEND (TUPLE TUPLE PROGN)
(TUPLE MAPCAR
(TUPLE CDADR
(TUPLE MEMBER (TUPLE QUOTE
ACCESS)
(TUPLE GETP
(@ ANY3)
DATA:STRUCTURE)))
(QUOTE (FUNCTION (LAMBDA (ACC)
(TUPLE SETQ
(CAR (LAST ACC))
(OUTVECTOR
(CADR ACC))))))))
(COMMENT AT
FIRST LOOK, WE DIDNT HAVE THE ACCESS INFO, SO WE WAITED
TILL LATER
TO STICK IN THESE BINDINGS)
(TUPLE GETP (@ B)
META:CODE))))
CODING:WARNING:LIST))
(QUOTE ((COMMENT AT
FIRST LOOK, WE DIDNT HAVE THE ACCESS INFO, SO WE WAITED TILL LATER
TO STICK IN THESE BINDINGS)))))
(MAPCAR L3 (FUNCTION (LAMBDA (L4)
(TUPLE COMMENT (@ L4)
HAD TO BE BOUND HERE))))
(CDDR BC)))))))
(VECTOR WE REPLACED ALL OCCURRENCES OF (INVECTOR ANY1) BY (INVECTOR ANY2)))
((OR (MATCH (VECTOR COMMENT ANY1 IN ANY2 UNDEFINED; WILL BE GOTTEN LATER; PROBABLY FRAG1 SINCE ANY3)
CHOICE)
(MATCH (VECTOR COMMENT WARNING ANY1 IN ANY2 UNDEFINED; WILL BE GOTTEN LATER; PROBABLY FRAG1 SINCE
ANY3)
CHOICE))
(PUPRIN1 (CONCAT "
MOVE CURSOR TO " ANY1 " WHICH IS LOCATED INSIDE " (GETP ANY2 META:CODE)
"
WHICH IS THE BLOCK OF CODE FOR THE FUNCTION " ANY2))
(COND
((NUMBERP (CAR (LAST (COLON:BREAK ANY2))))
(SETQ H1 ANY1)
(SETQ H2 ANY2)
(SETQ H3 FRAG1)
(SETQ TCHOICE H2)
(PUPRIN1
(CONCAT
"
PUP: WHILE LOOKING OVER SOME POSSIBLE ERRORS IN THE CODE SO FAR,
I NOTICE THAT WE HAVE LEFT " H1 " UNDEFINED. IT IS LOCATED IN
THE FUNCTION " H2 ". HERE IS A REPHRASED HINT: " ANY3 "
I SUSPECT THAT THE ANSWER IS " "SOME ELEMENT OF THIS LIST: " H3
".
PLEASE TYPE IN ONE OF THESE, OR ELSE YOUR OWN ANSWER, OR ELSE THE
SINGLE WORD 'DEFER' -- WHICH MEANS 'I AM UNSURE, SO COME BACK TO THIS
LATER.' GO AHEAD NOW
USER: "))
(SETQ RESPONSE (PREAD))
(COND
((EQUAL RESPONSE (QUOTE DEFER))
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(SETQ CODING:WARNING:LIST (NCONC1 CODING:WARNING:LIST (CONS (TIMES 3 (IMPROBABILITY:COMPLEX
WHOLE:CHOICE))
CHOICE)))
(VECTOR NOTHING))
((EQUAL H2 GLOBAL:CONTEXT:0)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(SETQ GLOBAL:INITIALIZATION:LIST (CONS (LIST (QUOTE SETQQ)
(SETQ IXS (COND
((MATCH (TUPLE INITIAL VALUE OF FRAG1)
(COLON:BREAK H1))
(COLON:BACK FRAG1))
(T H1)))
RESPONSE)
GLOBAL:INITIALIZATION:LIST))
(VECTOR (INVECTOR IXS)
WILL RECEIVE THE GLOBAL INITIALIZATION VALUE (INVECTOR RESPONSE)))
((MEMBER RESPONSE H3)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(MAPC SET:OF:BEING:PARTS (FUNCTION (LAMBDA (P)
(COND
((GETP H2 P)
(PUT H2 P (DSUBST RESPONSE H1 (GETP H2 P))))))))
(SETQ ARG:LIST (GETP H2 EXPLICIT:ARGS))
(VECTOR WE SUBSTITUTED (@ RESPONSE)
FOR (@ H1)
THROUGHOUT THE FUNCTION (@ H2)
.BY THE WAY, THIS WAS ONE
OF MY SUGGESTIONS!! THE META:CODE IS (SETQ AN1 (INVECTOR (GETP H2 META:CODE)))
(PROGN (SETQ AN2 (INVECTOR (PUT H2 META:CODE (GETCODE (OUTVECTOR (GETP H2 META:CODE))
H2 1))))
(COND
((EQUAL AN1 AN2)
(COMMENT NO FURTHER CHANGES NEED BE MADE IN THE META:CODE NOW))
(T (APPEND (COMMENT AS YOU KNOW, WE HAD TO CHANGE THE META:CODE, WHICH IS NOW)
(LIST AN2)))))))
(T (SETQ RESPONSE (OUTVECTOR (LIST:TRANSLATE (INVECTOR RESPONSE)
T)))
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(COND
((EQUAL (LENGTH RESPONSE)
1)
(SETQ RESPONSE (CAR RESPONSE))))
(MAPC SET:OF:BEING:PARTS (FUNCTION (LAMBDA (P)
(COND
((GETP H2 P)
(PUT H2 P (DSUBST RESPONSE H1 (GETP H2 P))))))))
(SETQ ARG:LIST (GETP H2 EXPLICIT:ARGS))
(VECTOR WE SUBSTITUTED (INVECTOR RESPONSE) FOR (INVECTOR H1)
THROUGHOUT THE FUNCTION (@ H2)
.THIS WASN'T WHAT I EXPECTED,
BY THE WAY. THE META:CODE IS (SETQ AN1 (INVECTOR (GETP H2 META:CODE)))
(PROGN (SETQ AN2 (INVECTOR (PUT H2 META:CODE (GETCODE (OUTVECTOR (GETP H2 META:CODE))
H2 1))))
(COND
((EQUAL AN1 AN2)
(COMMENT NO FURTHER CHANGES NEED BE MADE IN THE META:CODE NOW))
(T (APPEND (COMMENT AS YOU KNOW, WE HAD TO CHANGE THE META:CODE, WHICH IS NOW)
(LIST AN2)))))))))
(T (SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(VECTOR DUE TO THE CHARACTER OF (@ ANY2)
,I ASSUME THAT I AM NOT REALLY SUPPOSED
TO WORRY ABOUT THIS EVER.))))
((MATCH (VECTOR ANY1 IS A DATA STRUCTURE, WITH ELEMENTS OF TYPE ANY2 ;BUT NO ACCESSION INFORMATION IS
KNOWN)
CHOICE)
(SETQ H1 ANY1)
(SETQ H2 ANY2)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(COND
((EQUAL (CAR H2)
(QUOTE NOBIND))
(VECTOR I DONT THINK THIS MAKES TOO MUCH SENSE SO I AM GOING TO SKIP IT -- AT LEAST FOR NOW))
((SATISFY (VECTOR IS STRUCTURE (LIST VECTOR H1 H2)))
(VECTOR ACCESSION ROUTINES NOW EXIST FOR THE DATA STRUCTURE (@ H1)
;NAMELY,
(GETP H1 DATA:STRUCTURE)))
(T (SETQ CODING:WARNING:LIST (NCONC1 CODING:WARNING:LIST (CONS (TIMES 3 (CAR WHOLE:CHOICE))
CHOICE)))
(VECTOR WE UNSUCCESSFULLY TRIED TO DEVELOP ROUTINES FOR ACCESSION TO THE VAGUE DATA STRUCTURE
(@ H1)))))
((MATCH (VECTOR IN ANY1 WE SHOULD TACK ON ANY2)
CHOICE)
(PUPRIN1 (CONCAT "
MOVE CURSOR TO END OF THIS BLOCK OF CODE: " (GETP ANY1 META:CODE)
"
WHICH IS THE CODE FOR THE FUNCTION " ANY1))
(SETQ AN2 ANY2)
(SETQ AN1 ANY1)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(PUT AN1 META:CODE (COPY (NCONC1 (COPY (GETP AN1 META:CODE))
(SETQ GC2 (GETCODE AN2 AN1 -1)))))
(COND
((AND (SETQ AN3 (CAR (LAST AN2)))
(EQUAL (CAR AN3)
(QUOTE QUOTE))
(NOT (INSIDE (CADR AN3)
GLOBAL:INITIALIZATION:LIST))
(SETQ IV (COLON:BACK (TUPLE INITIAL:VALUE:OF (CADR AN3))))
(NOT (INSIDE IV CODING:WARNING:LIST)))
(SETQ CODING:WARNING:LIST (CONS (TUPLE 144 VECTOR COMMENT WARNING (@ IV)
IN GLOBAL:CONTEXT:0 UNDEFINED; WILL BE GOTTEN LATER; PROBABLY
NIL SINCE
(COMMENT WE DON'T SEEM TO EVER USE ANY INITIAL KNOWLEDGE
OF (CADR AN2)
IN ANY CRUCIAL WAY))
CODING:WARNING:LIST))))
(VECTOR WE TACKED ON (INVECTOR GC2) TO THE METACODE OF THE BEING (@ AN1)))
((MATCH (VECTOR IN ANY1 WE SHOULD REPLACE ANY2 BY ANY3)
CHOICE)
(PUPRIN1 (CONCAT "
MOVE CURSOR TO " ANY2 " WHICH IS LOCATED IN THE BLOCK OF CODE: " (GETP ANY1 META:CODE)
" WHICH IS THE BODY OF THE FUNCTION " ANY1))
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(MAPC SET:OF:BEING:PARTS (FUNCTION (LAMBDA (BP)
(PUT ANY1 BP (COPY (SUBST ANY3 ANY2 (COPY (GETP ANY1 BP))))))))
(VECTOR WE REPLACED (@ ANY2) BY (@ ANY3) IN THE BEING (@ ANY1)))
((MATCH (VECTOR WARNING WE HAVE FOUND NO ANY1 INTO ANY2 DATA STRUCTURE)
CHOICE)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(SETQ GD1 ANY1)
(SETQ GD2 ANY2)
(COND
((SATISFY (VECTOR SOME (@ GD1)
(@ GD2)))
(VECTOR WE KNOW ALL ABOUT THE PRESENCE/ABSENCE/DETAILS OF THE (@ GD1)
ASSOCIATED WITH THE DATA STRUCTURE
(@ GD2)))
(T (SETQ CODING:WARNING:LIST (NCONC1 CODING:WARNING:LIST (CONS (TIMES 3 (CAR WHOLE:CHOICE))
CHOICE)))
(VECTOR WE TRIED UNSUCCESSFULLY TO WORRY ABOUT THE FACT THAT THERE AREN'T ANY OBVIOUS
(@ GD1)
W.R.T THE DATA STRUCTURE (@ GD2)))))
((MATCH (VECTOR COMMAND IF ANY1 ANY2)
CHOICE)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(COND
((EVAL ANY1)
(VECTOR SINCE (INVECTOR ANY1)
EVALS TO A NONNULL VALUE, WE PERFORMED (INVECTOR ANY2)
,YIELDING THE VALUE (INVECTOR (EVAL ANY2))
,AND ARE FINISHED HERE))
(T (SETQ CODING:WARNING:LIST (CONS (CONS (TIMES 3 (CAR WHOLE:CHOICE))
(CDR WHOLE:CHOICE))
CODING:WARNING:LIST))
(VECTOR SORRY, I THOUGHT I MIGHT TAKE CARE OF THE COMMAND (INVECTOR ANY2)
,BUT
(INVECTOR ANY1)
IS NULL SO I CAN'T
DO IT NOW))))
((MATCH (VECTOR DELETE ALL MENTION OF ANY1 FROM ALL CODE GENERATED)
CHOICE)
(SETQ ANY1:COPY ANY1)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(MAPC ASSERT:LISTS (FUNCTION (LAMBDA (AL)
(SET AL (MAPCONC AL (FUNCTION (LAMBDA (PAL)
(COND
((MEMBER ANY1:COPY (FLATTEN PAL))
NIL)
(T (LIST PAL))))))))))
(MAPC (SETDIFFERENCE IS:BEING:LIST SET:OF:BEINGS)
(FUNCTION (LAMBDA (B)
(COND
((LISTP (GETP B META:CODE))
(PUT B META:CODE (CAR (OUTFORM ANY1:COPY (GETP B META:CODE)))))))))
(VECTOR WE DELETED ALL MENTION OF (@ ANY1:COPY) FROM ALL THE BEINGS CODES))
((MATCH (VECTOR INFINITE LOOP IN ANY1 FROM ANY2 TO ANY3)
CHOICE)
(PUPRIN1 (CONCAT "
MOVE CURSOR BACK AND FORTH OVER THE INFINITE LOOP FROM " ANY2 " TO " ANY3 " IN THE BLOCK OF CODE: " (GETP ANY1
META:CODE)
" WHICH IS ODY
OF THE FUNCTION
AT T" ANY1))
(SETQ HAN1 ANY1)
(SETQ HAN2 ANY2)
(SETQ HAN3 ANY3)
(SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(PUT HAN1 META:CODE
(SUBST (GETCODE (PROGN (PUPRIN1 "
AT THE END OF THIS BLOCK, WE'LL PUT IN SOMETHING LIKE THIS: ")
(TERPRI)
(PUPRINT (TUPLE COND (LIST (LIST IS:OF:TYPE (QUOTE ARG1)
(COMMENT BREAKAWAY))
(COMMENT FINALIZATION OF LOOP STARTING AT
(@ HAN2)
MAY GO HERE))
(LIST T (OUTVECTOR HAN3)))))
HAN1 0)
(OUTVECTOR HAN3)
(COPY (SUBST (COMMENT COMMENT SEE: THERE IS NO INFINITE LOOP
IN THIS PROG AFTER ALL; WE ARE EXITING IT!)
(COMMENT INFINITE LOOP IN THIS PROG)
(COPY (GETP HAN1 META:CODE))))))
(VECTOR INFINITE LOOP TERMINATION DECISION IS ABOUT TO BE INVESTIGATED, I BETCHA!!!))
(T (SETQ CODING:WARNING:LIST (PULLOUT WHOLE:CHOICE CODING:WARNING:LIST))
(SETQ CODING:WARNING:LIST (NCONC1 CODING:WARNING:LIST (CONS (TIMES 3 (IMPROBABILITY:COMPLEX
WHOLE:CHOICE))
CHOICE)))
(VECTOR NOTHING, SINCE I COULDNT UNDERSTAND IT)))))
(SATISFY (VECTOR AWARE USER (VECTOR PUP WORKED ON SOMETHING IMPROBABLE, NAMELY (INVECTOR CHOICE)
,AND HERE IS WHAT WE
FINALLY DID ABOUT IT:(INTUPLE WHAT:WE:DID))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(CLASSIFICATORY:CONCEPT:FORMATION
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS CLASSIFICATORY:CONCEPT:FORMATION BEING:STACK))
NIL
(PUT CLASSIFICATORY:CONCEPT:FORMATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (PARTITION:A:DOMAIN)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(COMPARE
(LAMBDA (POSSIBLE:OBJECT IDEAL:OBJECT FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS COMPARE BEING:STACK))
(PUT COMPARE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (COMMENT DEPENDS UPON THE PARTICULAR FLAVOR OF COMPARISON))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(COMPARITIVE:CONCEPT:FORMATION
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS COMPARITIVE:CONCEPT:FORMATION BEING:STACK))
NIL
(PUT COMPARITIVE:CONCEPT:FORMATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (PARTITION:A:DOMAIN)
(ORDER PARTITION)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(COMPLEX:ALTERATION
(LAMBDA (S FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS COMPLEX:ALTERATION BEING:STACK))
(PUT COMPLEX:ALTERATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (VECTOR DEPENDS ON WHAT THE USER WANTS DONE))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(CONDITIONAL:DELETION
(LAMBDA (E S FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS CONDITIONAL:DELETION BEING:STACK))
(PUT CONDITIONAL:DELETION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (VECTOR WE ASK THE USER))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(CONDITIONAL:INSERTION
(LAMBDA (E S FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS CONDITIONAL:INSERTION BEING:STACK))
(PUT CONDITIONAL:INSERTION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (VECTOR WE ASK THE USER))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(CONSTRAIN
(NLAMBDA (STRUC FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS CONSTRAIN BEING:STACK))
(PUT CONSTRAIN SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN
(PUPRIN1 "
YOU MUST GIVE ME A LIST OF ALL THE VALUES THAT COULD EVER OCCUR AS
NAMES ON THE LIST STRUCTURE ")
(PUPRINT STRUC)
(PUPRIN1 "IF THIS ISN'T MEANINGFUL, REPLY NIL.
USER: ")
(COND
((SETQ CL (PREAD))
(SETQ IS:CONSTRAINED:LIST (CONS (PROGN (MAPC CL (FUNCTION (LAMBDA (PN1)
(MAPC CL (FUNCTION (LAMBDA (PN2 BTYPE FNAME)
(SETQ BTYPE (COND
((EQUAL PN1 PN2)
MODIFY:STRUCTURE)
(T MAJOR:MODIFY:STRUCTURE)))
(SETQ FNAME (COLON:BACK (LIST PN1 PN2
MODIFY:STRUCTURE)))
(SETQ TYPE:OF:LIST
(CONS (VECTOR (@ FNAME)
TYPE OF (LIST VECTOR BTYPE)
IS UNKNOWN BUT IS
USED
IN (CADR CHOICE))
TYPE:OF:LIST))
(SETQ UNDEFINED:SECTION:LIST
(SETUNION UNDEFINED:SECTION:LIST
(LIST (VECTOR (@ FNAME)
TYPE
OF (LIST VECTOR BTYPE)))
))))))))
(LIST STRUC CL))
(CONS STRUC IS:CONSTRAINED:LIST)))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(DATA:STRUCTURE:DELETIONS
(LAMBDA (SNAME ENAME SINSERT RESPONSE NTAG SARG EVER:DID PRECISE:CALL OUTER:FN PLACEMENT NCODE DLOC FN:VALUE
FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS DATA:STRUCTURE:DELETIONS BEING:STACK))
(AND (OR ENAME (SETQ ENAME (COND
((MATCH (STRUCTURE (LIST ATOMS OF TYPE ANY1))
(GETP SNAME META:CODE))
ANY1)
(T (QUOTE ATOM)))))
(OR SINSERT (SETQ SINSERT (CADR (MEMBER (QUOTE DELETE)
(GETP SNAME DATA:STRUCTURE))))))
(PUT DATA:STRUCTURE:DELETIONS SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN
(SETQ EVER:DID 0)
(COND
((AND (NOT (FLOW:PRECEDED (VECTOR DELETE FROM (@ SNAME))))
(PUPRIN1 (CONCAT "
I AM NOT SURE WHETHER OR NOT TO DELETE ELEMENT(S) FROM " SNAME ".
SHOULD WE EVER DO SUCH DELETIONS?
USER: "))
(MEMBER (PREAD)
(TUPLE Y YES MAYBE)))
(MAPCAR
(SETDIFFERENCE IS:BEING:LIST SET:OF:BEINGS)
(FUNCTION (LAMBDA (B)
(SETQ SARG (CADR (MEMBER ENAME (TUPLE (DETERMINE:ARG:VALUE (LIST VECTOR B))
ARG1
(DETERMINE:ARG2:VALUE (LIST VECTOR B))
ARG2
(DETERMINE:ARG3:VALUE (LIST VECTOR B))
ARG3))))
(COND
((PROGN (SETQ NTAG2 NIL)
(SETQ NTAG (CAR (FIND:AND:TAG (COND
(SARG (TUPLE SET (@ SARG)
ANY1))
(T (TUPLE SETQ (@ ENAME)
ANY1)))
(GETP B META:CODE))))
NTAG2)
(PUPRINT (TUPLE I HAVE FOUND AND TAGGED THE ASSIGNMENTS TO))
(COND
(SARG (PUPRINT (TUPLE (@ SARG)
,WHICH IS INSTANTIATED AS))))
(PUPRINT (TUPLE (@ ENAME)
,WHICH IS THE TYPE OF ELEMENT OF THE DATA STRUCTURE (@ SNAME)
;SHOULD I DELETE A NEW LISP STATEMENT, JUST
AFTER THIS ASSIGNMENT, WHICH CONDITIONALLY
WILL DELETE THE NEW (@ ENAME)
INTO
(@ SNAME)
? ALL THIS IS
IN THE FUNCTION (@ B)
.ANSWER YES, NO,
OR UNSURE -- UNSURE MEANS THAT WE SHOULD BE MORE SPECIFIC ABOUT THIS
ASSIGNMENT ....))
(COND
((EQUAL (SETQ RESPONSE (PREAD))
(QUOTE UNSURE))
(PUPRINT NTAG)
(PUPRIN1
"
THIS IS THE CODE AND THE PROPOSED PLACE OF THE CONDITIONAL DELETEION.
NOW YOU MUST ANSWER YES OR NO
USER: ")
(SETQ RESPONSE (PREAD))))
(COND
((EQUAL RESPONSE (QUOTE YES))
(SETQ EVER:DID (ADD1 EVER:DID))
(PUPRIN1
"
OK, TYPE IN THE CONDITION NOW.
IT SHOULD BE A PREDICATE, WHICH IS TRUE IF THE DELETEION IS TO BE MADE,
AND FALSE IF THE INSERTION IS NOT TO BE MADE.
USER: ")
(PUT B META:CODE (GETCODE (SUBST (TUPLE COND (TUPLE (OUTVECTOR (TRANSLATE
(INVECTOR (PREAD))
T))
(SUBST (COND
(SARG)
(T (@ ENAME)))
(QUOTE X)
(CDDAR SINSERT))))
"***TAG***" NTAG)
B -1)))))))))
(COND
((NOT (ZEROP EVER:DID))
(VECTOR WE PUT IN A TOTAL OF (@ EVER:DID)
CONDITIONAL DELETIONS OF (PLURAL ENAME)
INTO
(@ SNAME)))
(T
(PUPRIN1
(CONCAT
"
I STILL HAVEN'T LOCATED ANY DELETEIONS AT ALL INTO THE DATA STRUCTURE
" SNAME "; PLEASE TELL ME WHEN I SHOULD (CONDITIONALLY) DURING THE
COURSE OF THE PROGRAM, DELETE A NEW MEMBER INTO " SNAME "
USER: "))
(SETQ HDLO (PREAD))
(COND
((MEMBER HDLO (TUPLE NOWHERE NEVER NONE))
(VECTOR THERE APPARENTLY ARE NO KNOWN DELETIONS INTO THE DATA STRUCTURE))
(T (SETQ DLOC (LOCATION:TRANSLATE HDLO))
(SETQ PRECISE:CALL (CAR DLOC))
(SETQ OUTER:FN (CADR DLOC))
(SETQ PLACEMENT (CADDR DLOC))
(SETQ NCODE (COPY (GETP OUTER:FN META:CODE)))
(SETQ NCODE (SELECTQ PLACEMENT
(AFTER (FIND:AND:TAG PRECISE:CALL NCODE))
(BEFORE (FIND:AND:PRETAG PRECISE:CALL NCODE))
(ERROR!)))
(PUPRIN1 (CONCAT "
OK, WHAT EXACTLY DO I DELETE INTO " SNAME "?
USER: "))
(SETQ RESPONSE (OUTVECTOR (TRANSLATE (INVECTOR (PREAD))
T)))
(PUPRIN1 (CONCAT "
OK, NOW TELL ME WHE CONDITION IER WHICH I SHOULD DELETE IN
U IN
U" RESPONSE " IN
US" SNAME "ER: ***TA"))
(PUT OUTER:FN META:CODE (GETCODE (SUBST (TUPLE COND (TUPLE (OUTVECTOR (TRANSLATE
(INVECTOR (PREAD))
T))
(SUBST RESPONSE (QUOTE X)
(CDDAR SINSERT))))
"***TAG***" NCODE)
OUTER:FN -1))
(SETQ EVER:DID (ADD1 EVER:DID))
(VECTOR WE FOUND NO PLACE TO PUT AN DELETEION, SO WE HAD TO QUERY THE USER, WHICH LED
TO PUTTING A CONDITIONAL DELETION INTO THE FUNCTION (@ OUTER:FN))))))))
(SETQ SOME:DELETIONS:LIST (CONS SNAME SOME:DELETIONS:LIST))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(DATA:STRUCTURE:INSERTIONS
(LAMBDA (SNAME ENAME SINSERT RESPONSE NTAG SARG EVER:DID PRECISE:CALL OUTER:FN PLACEMENT NCODE DLOC FN:VALUE
FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS DATA:STRUCTURE:INSERTIONS BEING:STACK))
(AND (OR ENAME (SETQ ENAME (COND
((MATCH (STRUCTURE (LIST ATOMS OF TYPE ANY1))
(GETP SNAME META:CODE))
ANY1)
(T (QUOTE ATOM)))))
(OR SINSERT (SETQ SINSERT (CADR (MEMBER (QUOTE INSERT)
(GETP SNAME DATA:STRUCTURE))))))
(PUT DATA:STRUCTURE:INSERTIONS SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN
(SETQ EVER:DID 0)
(COND
((AND (NOT (FLOW:PRECEDED (VECTOR INSERT INTO (@ SNAME))))
(PUPRIN1 (CONCAT "
I AM NOT SURE WHETHER OR NOT TO INSERT ELEMENT(S) INTO " SNAME ".
SHOULD WE EVER DO SUCH INSERTIONS?
USER: "))
(MEMBER (PREAD)
(TUPLE Y YES MAYBE)))
(MAPCAR
(SETDIFFERENCE IS:BEING:LIST SET:OF:BEINGS)
(FUNCTION (LAMBDA (B)
(SETQ SARG (CADR (MEMBER ENAME (TUPLE (DETERMINE:ARG:VALUE (LIST VECTOR B))
ARG1
(DETERMINE:ARG2:VALUE (LIST VECTOR B))
ARG2
(DETERMINE:ARG3:VALUE (LIST VECTOR B))
ARG3))))
(COND
((PROGN (SETQ NTAG2 NIL)
(SETQ NTAG (CAR (FIND:AND:TAG (COND
(SARG (TUPLE SET (@ SARG)
ANY1))
(T (TUPLE SETQ (@ ENAME)
ANY1)))
(GETP B META:CODE))))
NTAG2)
(PUPRINT (TUPLE I HAVE FOUND AND TAGGED THE ASSIGNMENTS TO))
(COND
(SARG (PUPRINT (TUPLE (@ SARG)
,WHICH IS INSTANTIATED AS))))
(PUPRINT (TUPLE (@ ENAME)
,WHICH IS THE TYPE OF ELEMENT OF THE DATA STRUCTURE (@ SNAME)
;SHOULD I INSERT A NEW LISP STATEMENT, JUST
AFTER THIS ASSIGNMENT, WHICH CONDITIONALLY
WILL INSERT THE NEW (@ ENAME)
INTO
(@ SNAME)
? ALL THIS IS
IN THE FUNCTION (@ B)
.ANSWER YES, NO,
OR UNSURE -- UNSURE MEANS THAT WE SHOULD BE MORE SPECIFIC ABOUT THIS
ASSIGNMENT ....))
(COND
((EQUAL (SETQ RESPONSE (PREAD))
(QUOTE UNSURE))
(PUPRINT NTAG)
(PUPRIN1
"
THIS IS THE CODE AND THE PROPOSED PLACE OF THE CONDITIONAL INSERTION.
NOW YOU MUST ANSWER YES OR NO
USER: ")
(SETQ RESPONSE (PREAD))))
(COND
((EQUAL RESPONSE (QUOTE YES))
(SETQ EVER:DID (ADD1 EVER:DID))
(PUPRIN1
"
OK, TYPE IN THE CONDITION NOW.
IT SHOULD BE A PREDICATE, WHICH IS TRUE IF THE INSERTION IS TO BE MADE,
AND FALSE IF THE INSERTION IS NOT TO BE MADE.
USER: ")
(PUT B META:CODE (GETCODE (SUBST (TUPLE COND (TUPLE (OUTVECTOR (TRANSLATE
(INVECTOR (PREAD))
T))
(SUBST (COND
(SARG)
(T (@ ENAME)))
(QUOTE X)
(CDDAR SINSERT))))
"***TAG***" NTAG)
B -1)))))))))
(COND
((NOT (ZEROP EVER:DID))
(VECTOR WE PUT IN A TOTAL OF (@ EVER:DID)
CONDITIONAL INSERTIONS OF (PLURAL ENAME)
INTO
(@ SNAME)))
(T
(PUPRIN1
(CONCAT
"
I STILL HAVEN'T LOCATED ANY INSERTIONS AT ALL INTO THE DATA STRUCTURE
" SNAME "; PLEASE TELL ME WHEN I SHOULD (CONDITIONALLY) DURING THE
COURSE OF THE PROGRAM, INSERT A NEW MEMBER INTO " SNAME "
USER: "))
(SETQ HDLO (PREAD))
(COND
((MEMBER HDLO (TUPLE NOWHERE NEVER NONE))
(VECTOR THERE APPARENTLY ARE NO KNOWN INSERTIONS INTO THE DATA STRUCTURE))
(T (SETQ DLOC (LOCATION:TRANSLATE HDLO))
(SETQ PRECISE:CALL (CAR DLOC))
(SETQ OUTER:FN (CADR DLOC))
(SETQ PLACEMENT (CADDR DLOC))
(SETQ NCODE (COPY (GETP OUTER:FN META:CODE)))
(SETQ NCODE (SELECTQ PLACEMENT
(AFTER (FIND:AND:TAG PRECISE:CALL NCODE))
(BEFORE (FIND:AND:PRETAG PRECISE:CALL NCODE))
(ERROR!)))
(PUPRIN1 (CONCAT "
OK, WHAT EXACTLY DO I INSERT INTO " SNAME "?
USER: "))
(SETQ RESPONSE (OUTVECTOR (TRANSLATE (INVECTOR (PREAD))
T)))
(PUPRIN1 (CONCAT "
OK, NOW TELL ME WHAT THE CONDITION IS UNDER WHICH I SHOULD INSERT " RESPONSE " INTO " SNAME "?
USER: "))
(PUT OUTER:FN META:CODE (GETCODE (SUBST (TUPLE COND (TUPLE (OUTVECTOR (TRANSLATE
(INVECTOR (PREAD))
T))
(SUBST RESPONSE (QUOTE X)
(CDDAR SINSERT))))
"***TAG***" NCODE)
OUTER:FN -1))
(SETQ EVER:DID (ADD1 EVER:DID))
(VECTOR WE FOUND NO PLACE TO PUT AN INSERTION, SO WE HAD TO QUERY THE USER, WHICH LED
TO PUTTING A CONDITIONAL INSERTION INTO THE FUNCTION (@ OUTER:FN))))))))
(SETQ SOME:INSERTIONS:LIST (CONS SNAME SOME:INSERTIONS:LIST))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(DEFER:DECISION
(LAMBDA (D SITU FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS DEFER:DECISION BEING:STACK))
(MEMBER D UNDEFERRED:DECISION:LIST)
(PUT DEFER:DECISION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR USER:INTERRUPT:DEMONS (QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ UNDEFERRED:DECISION:LIST (PULLOUT D UNDEFERRED:DECISION:LIST))
(SETQ SITU (WHEN:NEXT (VECTOR PUP REINVESTIGATE (@ D))))
(COND
((EQUAL (CAR SITU)
VECTOR)
(SETQ SITU (CDR SITU))))
(COND
((EVAL SITU)
(RESOLVE:DECISION (VECTOR (@ D)
SINCE
(@ SITU))))
((EQUAL SITU (LIST FOREVER))
T)
(T (SETQ DEFERRED:DECISION:LIST (CONS (VECTOR (@ D) UNTIL (@ SITU))
DEFERRED:DECISION:LIST))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(ENCODE
(LAMBDA (FUNC FNAME FDESC F1 CODE FARGS YY ORIG:FUNC ARG:LIST ARG:COMMENTS PCOUNT FARGS1 FARGS2 TEMPFARGS CFLAT BNAME
TNAME ARG1LIST ARG2LIST FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS ENCODE BEING:STACK))
(PROGN (SETQ ORIG:FUNC FUNC)
(AND (OR (AND (MATCH (VECTOR (VECTOR FRAG1)
NAME ANY1 FRAG2 ANY2)
FUNC)
(SETQ FDESC FRAG1)
(SETQ FNAME ANY1)
(SETQ BNAME ANY2)
(SETQ F1 (CADR FDESC)))
(COND
((ATOM FUNC)
NIL)
(T (SETQ FUNC (CADR FUNC))
NIL))
(AND (SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TT)
(COND
((EQUAL (CADR TT)
FUNC)
(SETQ F1 (SETQ FDESC (CADDDR (CDDDR TT))))
(SETQ FNAME FUNC)
(SETQ BNAME (CAR (OUTVECTOR (CADDR (CDDR TT)))))
(SETQ TNAME (CAR (LAST TT)))
T)))))
(COND
((NULL F1)
(SETQ F1 FNAME)
(SETQ TYPE:OF:LIST (NCONC1 TYPE:OF:LIST (VECTOR (@ F1)
IS
(SUBPAIR (GETP BNAME
EXPLICIT:ARGS)
(CDR FUNC)
(GETP BNAME META:CODE)
T)))))
((MEMBER (VECTOR (@ FUNC)
TYPE OF (LIST VECTOR BNAME))
ENCODABLE:SECTION:LIST))
((MEMBER FUNC ENCODABLE:SECTION:LIST))
((GETP BNAME ENCODABLE)
(SETQ TYPE:OF:LIST
(CONS (VECTOR (@ FNAME)
TYPE
OF (@ BNAME)
IS
(SETQ F1
(SETQ FDESC
(INVECTOR (INSTANTIATE (SUBPAIR (GETP BNAME EXPLICIT:ARGS)
(FIRSTN (LENGTH
(GETP BNAME
EXPLICIT:ARGS))
(TUPLE ARG1 ARG2
ARG3 ARG4))
(GETP BNAME META:CODE))))))
AND IS USED
IN (@ TNAME))
TYPE:OF:LIST))
(SETQ F1 FDESC)
(SETQ ENCODABLE:SECTION:LIST (CONS FUNC ENCODABLE:SECTION:LIST))))))
(OR (SATISFY (VECTOR ENCODABLE SECTION ORIG:FUNC))
(SATISFY (VECTOR ENCODABLE SECTION FUNC)))))
(PUT ENCODE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN (MAPC TYPE:OF:LIST (FUNCTION (LAMBDA (PC)
(COND
((MATCH (VECTOR (@ F1)
IS FRAG1)
PC)
(SETQ CODE FRAG1))))))
(COND
((NULL CODE)
(PUPRIN1 "
MOVE CURSOR TO ")
(PUPRINT FNAME)
(PUPRIN1 "
PUP IS NOW GOING TO ENCODE THE PIECE
")
(PUPRETTYPRINT (LIST (LIST (OUTVECTOR F1))))
(PUPRIN1 "
OF THE FUNCTION ")
(PUPRIN1 FNAME)
(PUPRIN1 " INTO LISP. FUNCTION NAMES WILL
BE QUERIED IN PREORDER, AS NEEDED.
")
(SETQ ARG:LIST (CDR (SASSOC FNAME TRUE:FN:CALL:LIST)))
(SETQ CODE (LIST (GETCODE (OUTVECTOR F1)
FNAME 1)))
(SETQ FARGS (INTERSECTION FARGS FARGS))
(COND
((GREATERP (LENGTH FARGS)
(LENGTH ARG:LIST))
(SETQ FARGS (SETDIFFERENCE FARGS TRIVIAL:BEING:LIST))))
(COND
((GREATERP (LENGTH FARGS)
(LENGTH ARG:LIST))
(SETQ FARGS (SETDIFFERENCE FARGS ARG:LIST))))
(COND
((LESSP (LENGTH FARGS)
(LENGTH ARG:LIST))
(SETQ FARGS (APPEND FARGS (DUMMIES (DIFFERENCE (LENGTH ARG:LIST)
(LENGTH FARGS)))))))
(SETQ FARGS (FIRSTN (LENGTH ARG:LIST)
FARGS))
T)
(T (SETQ FARGS (APPEND (GETP (CAR FDESC)
EXPLICIT:ARGS)
(GETP (CAR FDESC)
IMPLICIT:ARGS)))
(SETQ UNDEFINED:SECTION:LIST (SETUNION UNDEFINED:SECTION:LIST
(SETDIFFERENCE (OUTNIL (FLATTEN CODE))
(APPEND WRITTEN:PROGRAMS:LIST
PUP6FNS
PRIMITIVE:PROGRAMS:LIST
PRIMITIVE:VARS:LIST
IS:BEING:LIST
SET:OF:BEING:PARTS PUP6VARS)
)))))
(SETQ FARGS1 (MAPCONC FARGS (FUNCTION (LAMBDA (FF)
(COND
((MATCH (TUPLE A R G FRAG1)
(UNPACK FF))
(LIST FF)))))))
(SETQ FARGS2 (SETDIFFERENCE FARGS FARGS1))
(SETQ FARGS1 (SORT (COPY FARGS1)))
(SETQ TEMPFARGS NIL)
(SETQ PCOUNT 0)
(MAPC FARGS (FUNCTION (LAMBDA NIL
(SETQ PCOUNT (ADD1 PCOUNT))
(COND
((MATCH (TUPLE A R G (@ PCOUNT))
(UNPACK (CAR FARGS1)))
(SETQ TEMPFARGS (NCONC1 TEMPFARGS (CAR FARGS1)))
(SETQ FARGS1 (CDR FARGS1)))
(T (SETQ TEMPFARGS (NCONC1 TEMPFARGS (CAR FARGS2)))
(SETQ FARGS2 (CDR FARGS2)))))))
(SETQ FARGS TEMPFARGS)
(COND
((AND (NOT (MATCH (COMMENT IN ALL CALLS TO DATE, ARG2 FRAG1)
(MEMBER COMMENT (CDR (MEMBER COMMENT (MEMBER COMMENT (SETQ CFLAT
(FLATTEN CODE))))))))
(MEMBER (QUOTE ARG3)
CFLAT))
(SETQ CODE (CONS (COMMENT IN ALL CALLS TO DATE, ARG3 IS INSTANTIATED AS (
DETERMINE:ARG3:VALUE CHOICE))
CODE))))
(COND
((AND (NOT (MATCH (COMMENT IN ALL CALLS TO DATE, ARG2 FRAG1)
(MEMBER COMMENT (CDR (MEMBER COMMENT CFLAT)))))
(MEMBER (QUOTE ARG2)
CFLAT))
(SETQ CODE (CONS (COMMENT IN ALL CALLS TO DATE, ARG2 IS INSTANTIATED AS (
DETERMINE:ARG2:VALUE CHOICE))
CODE))))
(COND
((AND (NOT (MATCH (COMMENT IN ALL CALLS TO DATE, ARG1 FRAG1)
(MEMBER COMMENT CFLAT)))
(MEMBER (QUOTE ARG1)
CFLAT))
(SETQ CODE (CONS (COMMENT IN ALL CALLS TO DATE, ARG1 IS INSTANTIATED AS (
DETERMINE:ARG:VALUE CHOICE))
CODE))))
(COND
((AND ARG2 (SETQ ARG2LIST (DETERMINE:ALL:ARG2:VALUES CHOICE))
(CDR (SETQ ARG2LIST (SETINTERSECTION ARG2LIST ARG2LIST))))
(SETQ CODE
(CONS (COMMENT I SEE THAT WE MAY ACTUALLY CALL THE FUNCTION
WITH ARG2 ANY OF THE FOLLOWING:(INVECTOR ARG2LIST))
CODE))))
(COND
((AND ARG1 (SETQ ARG1LIST (DETERMINE:ALL:ARG:VALUES CHOICE))
(SETQ ARG1LIST (SETINTERSECTION ARG1LIST ARG1LIST))
(CDR ARG1LIST))
(SETQ CODE
(CONS (COMMENT I SEE THAT WE MAY ACTUALLY CALL THE FUNCTION
WITH ARG1 ANY OF THE FOLLOWING:(INVECTOR ARG1LIST))
CODE))))
(EVAL (LIST (QUOTE DEFINEQ)
(LIST FNAME (APPEND (LIST (COND
((GETP BNAME NLAMBDA)
NLAMBDA)
(T (QUOTE LAMBDA))))
(LIST (COND
(FARGS)
(T NIL)))
CODE))))
(PUPRIN1 (CONCAT "
DRAW A LINE FROM THE FUNCTION CALL " (SASSOC FNAME TRUE:FN:CALL:LIST)
" OF THE FUNCTION " FNAME " TO THIS NEW PIECE OF CODE, WHICH IS ITS BODY:
"))
(PUPRETTYPRINT (LIST FNAME))
(LIST (VECTOR WE DEFINE THE FUNCTION (@ FNAME)
AS:(INVECTOR CODE)))))
(SATISFY (VECTOR IS BEING FNAME))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(EXAMINE:STRUCTURE
(LAMBDA (PAT L FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS EXAMINE:STRUCTURE BEING:STACK))
(COND
((EQUAL (CAR (QUOTE DSMATCH))
(QUOTE NOBIND))
(SETQQ DSMATCH MATCH))
(T T))
(PUT EXAMINE:STRUCTURE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PUPRIN1 (CONCAT "
THOSE MATCHING ARE: " (MAPCONC (COND
((ATOM L)
(EVAL L))
(T L))
(FUNCTION (LAMBDA (E)
(COND
(($ (TUPLE (@ DSMATCH)
PAT E))
(LIST (CDR E))))))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(EXTRACT:RELEVANT:SUBSET
(LAMBDA (NEW:INFO FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS EXTRACT:RELEVANT:SUBSET BEING:STACK))
(MEMBER NEW:INFO NEW:INFO:LIST)
(PUT EXTRACT:RELEVANT:SUBSET SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (USE:PROGRAMMING:KNOWLEDGE APPLIED TO NEW:INFO SO:AS:TO KEEP (VECTOR RELEVANT
NEW:INFO))
(SETQ RELEVANT:INFO:LIST (CONS NEW:INFO RELEVANT:INFO:LIST))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(FAST:GET:NAME
(LAMBDA (EXPRESSION NEW:NAME TEMP1 NE EV:NEW:NAME TEMPINT TREAD FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS FAST:GET:NAME BEING:STACK))
(SATISFY (VECTOR PUP STUDIED (VECTOR PLAUSIBLE NAMES FOR (@ EXPRESSION))))
(SATISFY (VECTOR AWARE USER (VECTOR PUP WANTS USER TO TYPE IN NAME FOR (@ EXPRESSION))))
(COND
((NOT (ATOM NEW:NAME))
(SETQ NEW:NAME (CADR NEW:NAME)))
(T T))
(SETQ EV:NEW:NAME (COND
((ATOM NEW:NAME)
NEW:NAME)
(T (EVAL NEW:NAME))))
(PUT FAST:GET:NAME SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(COND
((OR (NUMBERP (CAR (LAST (COLON:BREAK EV:NEW:NAME))))
(AND (MATCH (VECTOR ANY2)
EXPRESSION)
(NUMBERP (CAR (LAST (COLON:BREAK (CADR EXPRESSION)))))))
(PUPRIN1
"
HMMMMM..... IT SEEMS I'VE SEEN THIS IDENTIFIER BEFORE. I WON'T NEED
YOUR INTERACTION AFLL. SORRY TO TROUBLE YOU.
IS TH")
(SET (COND
((ATOM NEW:NAME)
NEW:NAME)
((ATOM (EVAL NEW:NAME))
(EVAL NEW:NAME))
(T (CADR (EVAL NEW:NAME))))
(CADR EXPRESSION))
(SETQ OLDNAME:TAG T)
(SETQ NAMED:EXPRESSION:LIST (CONS EXPRESSION NAMED:EXPRESSION:LIST)))
(T
(COND
((MEMBER EXPRESSION NAMED:EXPRESSION:LIST)
(TERPRI)
(PUPRIN1 (CONCAT "IS THIS THE SAME AS A " EXPRESSION " WHICH WE'VE ALREADY SEEN AND NAMED?
USER: "))
(SETQ TEMP1 (MEMBER (PREAD)
(QUOTE (Y YES MAYBE))))))
(COND
(TEMP1 (SETQ NE (INTERSECTION (SETQ TEMPINT (MAPCONC TYPE:OF:LIST (FUNCTION (LAMBDA (TOL)
(COND
((MATCH (VECTOR ANY1 TYPE
OF (@ EXPRESSION)
FRAG1)
TOL)
(LIST ANY1)))))))
TEMPINT))))
(COND
((CDR NE)
(PUPRIN1
(CONCAT
NE " ARE SUCH NAMES. "
"
SINCE THERE IS MORE THAN ONE, PLEASE TYPE IN TO ME THE NAME, AGAIN,
OF ONE OF THE ABOVE" "
OR TYPE IN ] IF THE NAME YOU WANT ISALLY ONE OF THESE AFTER ALL.
USER: SINCE"))
(SETQ TEMP1 (PREAD)))
(NE (PUPRIN1 (CONCAT "SINCE " (CAR NE)
" IS THE ONLY NAME FOR " EXPRESSION
",
AT LEAST AS FAR AS PUP KNOWS RIGHT NOW, PUP ASSUMES THAT IS THE ONE
YOU WANT. AM I RIGHT?
USER: "))
(SETQ TEMP1 (COND
((MEMBER (PREAD)
(QUOTE (Y YES)))
(CAR NE)))))
(T (PUPRIN1 (CONCAT "I DON'T KNOW ANY NAMES FOR " EXPRESSION
", SO YOU'LL HAVE TO
TYPE A BRAND NEW NAME IN TO ME. "))
(TERPRI)
(SETQ TEMP1 NIL)))
(COND
(TEMP1 (SETQ OLDNAME:TAG T)
(SET (COND
((ATOM NEW:NAME)
NEW:NAME)
((EVAL NEW:NAME))
(T UNKNOWN:THING:ERROR))
TEMP1))
(T (PUPRIN1 "USER: ")
(SETQ TREAD (PREAD))
(SETQ TREAD (COND
(TREAD)
((COLON:BACK (OUTVECTOR (OUTNIL (FLATTEN EXPRESSION)))))))
(COND
((NOT (OR (MEMBER TREAD PRIMITIVE:PROGRAMS:LIST)
(NUMBERP (CAR (LAST (COLON:BREAK TREAD))))))
(SETQ TREAD (PACK (TUPLE (@ TREAD):(SETQ NEW:F:NUMBER (ADD1 NEW:F:NUMBER)))))))
(SET (COND
((ATOM NEW:NAME)
NEW:NAME)
((EVAL NEW:NAME))
(T UNKNOWN:THING:ERROR))
TREAD)
(SET TREAD TREAD)
(SETQ NAMED:EXPRESSION:LIST (CONS EXPRESSION NAMED:EXPRESSION:LIST)))))))
(SATISFY (VECTOR AWARE USER (VECTOR PUP AND USER ARE ABLE TO REFER TO (@ EXPRESSION) AS (@ NEW:NAME)
WHICH IS (EVAL NEW:NAME)
)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(FAST:SATISFY
(LAMBDA (G FORCE:SAT TEMP:LIST EV:G FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS FAST:SATISFY BEING:STACK))
(SETQ G (EVAL G))
(SETQ EV:G (EVAL (CADDDR G)))
(PUT FAST:SATISFY SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR USER:INTERRUPT:DEMONS (QUOTE APPLY*))))
(SETQ FN:VALUE
(COND
((AND (MEMBER EV:G (FIRSTN 90 (EVAL (SETQ TEMP:LIST (COLON:BACK (COPY (LIST (CADR G)
(CADDR G)
(QUOTE LIST))))))))
(NOT FORCE:SAT)))
(T (PROG (B:LIST)
(MAPC EFFECTS:TABLE (FUNCTION (LAMBDA (E1)
(COND
((MATCH (CAR E1)
G)
(SETQ B:LIST (CONS (EVAL (CADR E1))
B:LIST)))))))
(SETQ BECAUSE (VECTOR WE CALL THE SIMPLEST BEING WHICH CAN BRING ABOUT THE EFFECT (@ G)))
(COND
(B:LIST (RETURN (PROG (CB:LIST POS:B)
(SETQ CB:LIST (COPY (MAPCAR B:LIST (QUOTE CDR))))
(SETQ CB:LIST (INTERSECTION CB:LIST CB:LIST))
(SORT CB:LIST A:BEING:ORDER)
LABEL5
(SETQ POS:B (CAR CB:LIST))
(EVAL POS:B)
(COND
((MEMBER EV:G (EVAL TEMP:LIST))
(RETURN (SETQ PUP:SATISFIED:LIST (CONS G PUP:SATISFIED:LIST))))
((CDR CB:LIST)
(SETQ CB:LIST (CDR CB:LIST))
(GO LABEL5))
((MEMBER G USER:WARNING:LIST)
(RETURN NIL))
(T (PUPRIN1 "
WARNING: SATISFY IS SHAKING ITS HEAD ABOUT THIS ONE:")
(PUPRIN1 G)
(SETQ USER:WARNING:LIST (CONS G USER:WARNING:LIST))
(RETURN NIL))))))
(T (RETURN NIL)))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(FILL:IN:UNDEFINED:SECTION
(LAMBDA (PROGRAM OLD:DO:LIST XTHING TC NEW:PIECE FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS FILL:IN:UNDEFINED:SECTION BEING:STACK))
UNDEFINED:SECTION:LIST
(SETQ OLD:DO:LIST DOING:PUP:LIST)
(SETQ CHOICE (INVECTOR (MINIMUM (COND
((SETINTERSECTION UNDEFINED:SECTION:LIST ENCODABLE:SECTION:LIST))
(T UNDEFINED:SECTION:LIST))
FAST:BEING:COMPLEX)))
(SETQ DOING:PUP:LIST (CONS CHOICE DOING:PUP:LIST))
(SATISFY (VECTOR TYPE OF (VECTOR (SETQ XTHING
(VECTOR (PROG1 (COND
((ATOM CHOICE)
(SETQ TC CHOICE))
((MATCH (VECTOR ANY1 TYPE OF (VECTOR ANY2))
CHOICE)
(SETQ TC ANY1)
ANY2)
(T (SETQ TC (CAR (OUTVECTOR CHOICE)))))
(SETQ DOING:PUP:LIST (CONS (INVECTOR (SASSOC TC
TRUE:FN:CALL:LIST))
DOING:PUP:LIST))
(MAPC (CDR (SASSOC TC TRUE:FN:CALL:LIST))
(FUNCTION (LAMBDA (AA)
(COND
((ATOM AA)
(SATISFY (VECTOR TYPE
OF (VECTOR (LIST VECTOR AA)
HAS BEEN STUDIED)
))))))))))
HAS BEEN STUDIED))
(AND (NOT (CAR (NLSETQ (SASSOC TC (OUTVECTOR OLD:DO:LIST)))))
(SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOLL)
(AND (MATCH (VECTOR ANY1 TYPE OF (@ XTHING)
FRAG1)
TOLL)
(NOT (EQUAL ANY1 TC))))))
T))
(PUT FILL:IN:UNDEFINED:SECTION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (COND
((SETQ NEW:PIECE (ENCODE CHOICE))
(SETQ UNDEFINED:SECTION:LIST (PULLOUT CHOICE UNDEFINED:SECTION:LIST))
(COND
((MATCH (VECTOR ANY1 TYPE OF (VECTOR ANY2))
CHOICE)
(SETQ UNDEFINED:SECTION:LIST (PULLOUT (LIST VECTOR ANY2)
UNDEFINED:SECTION:LIST))))
(SETQ ENCODABLE:SECTION:LIST (PULLOUT CHOICE ENCODABLE:SECTION:LIST))
(SETQ ENCODABLE:SECTION:LIST (PULLOUT (CADR CHOICE)
ENCODABLE:SECTION:LIST))
(SET PROGRAM (APPEND (EVAL PROGRAM)
NEW:PIECE)))
(T (SETQ DOING:PUP:LIST (CDDR DOING:PUP:LIST))
(SETQ PUP:WANTS:LIST (CONS (VECTOR MORE INFO RELEVANT TO MAKING (@ CHOICE)
CODABLE)
PUP:WANTS:LIST))
NIL)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(FOREACH
(NLAMBDA (X IN XSET DO ACTION EVAL:ARG3 FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS FOREACH BEING:STACK))
(PUT FOREACH SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG (RESULTT)
(SETQ EVAL:ARG3 (EVAL XSET))
LABELL
(COND
((NULL EVAL:ARG3)
(SET X UNKNOWN)
(RETURN T)))
(SET X (CAR EVAL:ARG3))
(SETQ EVAL:ARG3 (CDR EVAL:ARG3))
(SETQ RESULTT (EVAL ACTION))
(GO LABELL)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(GET:DATA:STRUCTURE
(LAMBDA (SNAME ENAME SCODE STYPE FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS GET:DATA:STRUCTURE BEING:STACK))
(AND SNAME (OR (NULL ENAME)
(LESSP 2 (LENGTH (GETP ENAME DATA:STRUCTURE)))
(AND (SATISFY (VECTOR IS STRUCTURE ENAME))
(PUT ENAME DATA:STRUCTURE (APPEND (GETP ENAME DATA:STRUCTURE)
(TUPLE PARENT (@ SNAME)))))))
(PUT GET:DATA:STRUCTURE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROG1
(COND
((OR (EQUAL T (GETP SNAME DATA:STRUCTURE))
(EQUAL (QUOTE ACCESS)
(CAR (GETP SNAME DATA:STRUCTURE))))
(SETQ STYPE (SELECT:STRUCTURE:TYPE (SETQ SCODE (GETP SNAME META:CODE))))
(PUT SNAME DATA:STRUCTURE (EVAL (EVAL (PACK (LIST STYPE (QUOTE :SETUP)))))))
((MEMBER SNAME ISNT:STRUCTURE:LIST))
(T (PUPRIN1 "
PUP: SORRY TO BOTHER YOU, BUT I MUST KNOW IF THE FOLLOWING IS A
DATA STRUCTURE: ")
(PUPRIN1 SNAME)
(PUPRIN1 ". PLEASE ANSWER YES OR NO
USER: ")
(COND
((MEMBER (PREAD)
(VECTOR Y YES MAYBE))
(SETQ CODE (TUPLE STRUCTURE (TUPLE LIST ATOMS OF TYPE (@ ENAME))))
(SETQ BNAME LIST:STRUCTURE)
(SETQ FNAME SNAME)
(SATISFY (VECTOR IS BEING FNAME))
(PUT SNAME DATA:STRUCTURE (EVAL (EVAL (PACK (TUPLE (SELECT:STRUCTURE:TYPE (SETQ SCODE
(GETP SNAME META:CODE))
):SETUP))))))
(T (SETQ ISNT:STRUCTURE:LIST (CONS SNAME ISNT:STRUCTURE:LIST))))))
(COND
((GETP SNAME DATA:STRUCTURE)
(SETQ CODING:WARNING:LIST (NCONC1 CODING:WARNING:LIST (TUPLE (COND
(ENAME 100)
(266))
VECTOR WARNING WE HAVE FOUND NO INSERTIONS
INTO (@ SNAME)
DATA STRUCTURE)))
(SETQ CODING:WARNING:LIST (NCONC1 CODING:WARNING:LIST (TUPLE (COND
(ENAME 101)
(267))
VECTOR WARNING WE HAVE FOUND NO DELETIONS
INTO (@ SNAME)
DATA STRUCTURE)))
(SETQ IS:STRUCTURE:LIST (CONS SNAME (CONS (LIST VECTOR SNAME ENAME)
IS:STRUCTURE:LIST)))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(GET:HOLD:OF
(NLAMBDA (ENTITY FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS GET:HOLD:OF BEING:STACK))
(PUT GET:HOLD:OF SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (OR (TAKE:HOLD:OF ENTITY)
(ASK:USER:ABOUT ENTITY)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(GET:NAME
(LAMBDA (EXPRESSION NEW:NAME TEMP1 NE EV:NEW:NAME TEMPINT TREAD FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS GET:NAME BEING:STACK))
(COND
((NOT (ATOM NEW:NAME))
(SETQ NEW:NAME (CADR NEW:NAME)))
(T T))
(SETQ EV:NEW:NAME (COND
((ATOM NEW:NAME)
NEW:NAME)
(T (EVAL NEW:NAME))))
(PUT GET:NAME SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN
(PUPRIN1 (CONCAT "
PUP WANTS USER TO TYPE IN NAME FOR " EXPRESSION))
(COND
((OR (NUMBERP (CAR (LAST (COLON:BREAK EV:NEW:NAME))))
(AND (MATCH (VECTOR ANY2)
EXPRESSION)
(NUMBERP (CAR (LAST (COLON:BREAK (CADR EXPRESSION)))))))
(PUPRIN1
"
HMMMMM..... IT SEEMS I'VE SEEN THIS IDENTIFIER BEFORE. I WON'T NEED
YOUR INTERACTION AFLL. SORRY TO TROUBLE YOU.
IS TH")
(SET (COND
((ATOM NEW:NAME)
NEW:NAME)
((ATOM (EVAL NEW:NAME))
(EVAL NEW:NAME))
(T (CADR (EVAL NEW:NAME))))
(CADR EXPRESSION))
(SETQ OLDNAME:TAG T)
(SETQ NAMED:EXPRESSION:LIST (CONS EXPRESSION NAMED:EXPRESSION:LIST)))
(T (COND
((MEMBER EXPRESSION NAMED:EXPRESSION:LIST)
(TERPRI)
(PUPRIN1 (CONCAT "IS THIS THE SAME AS A " EXPRESSION
" WHICH WE'VE ALREADY SEEN AND NAMED?
USER: "))
(SETQ TEMP1 (MEMBER (PREAD)
(QUOTE (Y YES MAYBE))))))
(COND
(TEMP1 (SETQ NE (INTERSECTION (SETQ TEMPINT (MAPCONC TYPE:OF:LIST
(FUNCTION (LAMBDA (TOL)
(COND
((MATCH (VECTOR ANY1 TYPE
OF (@ EXPRESSION)
FRAG1)
TOL)
(LIST ANY1)))))))
TEMPINT))))
(COND
((CDR NE)
(PUPRIN1 (CONCAT NE " ARE SUCH NAMES. " "
SINCE THERE IS MORE THAN ONE, TYPE IN THE NAME (AGAIN) " "
OF ONE OF THE ABOVE " "OR TYPE ] IF THE NAME YOU REALLY " "
WANT ISNT ONE OF THESE AFTER ALL " "
USER: "))
(SETQ TEMP1 (PREAD)))
(NE (PUPRIN1 (CONCAT "SINCE " (CAR NE)
" IS THE ONLY NAME FOR " EXPRESSION
",
AT LEAST AS FAR AS PUP KNOWS RIGHT NOW, PUP ASSUMES THAT IS THE ONE
YOU WANT. AM I RIGHT?
USER: "))
(SETQ TEMP1 (COND
((MEMBER (PREAD)
(QUOTE (Y YES)))
(CAR NE)))))
(T (PUPRIN1 (CONCAT "I DON'T KNOW ANY NAMES FOR " EXPRESSION
", SO YOU'LL HAVE TO
TYPE A BRAND NEW NAME IN TO ME. "))
(TERPRI)
(SETQ TEMP1 NIL)))
(COND
(TEMP1 (SETQ OLDNAME:TAG T)
(SET (COND
((ATOM NEW:NAME)
NEW:NAME)
((EVAL NEW:NAME))
(T UNKNOWN:THING:ERROR))
TEMP1))
(T (PUPRIN1 "USER: ")
(SETQ TREAD (PREAD))
(SETQ TREAD (COND
(TREAD)
((COLON:BACK (OUTVECTOR (OUTNIL (FLATTEN EXPRESSION)))))))
(COND
((NOT (OR (MEMBER TREAD PRIMITIVE:PROGRAMS:LIST)
(NUMBERP (CAR (LAST (COLON:BREAK TREAD))))))
(SETQ TREAD (PACK (TUPLE (@ TREAD):(SETQ NEW:F:NUMBER (ADD1 NEW:F:NUMBER)))))))
(SET (COND
((ATOM NEW:NAME)
NEW:NAME)
((EVAL NEW:NAME))
(T UNKNOWN:THING:ERROR))
TREAD)
(SET TREAD TREAD)
(SETQ NAMED:EXPRESSION:LIST (CONS EXPRESSION NAMED:EXPRESSION:LIST))))))
(PUPRIN1 "
THE NAME CHOSEN IS ")
(PUPRINT (EVAL NEW:NAME))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(GET:NEW:INFORMATION
(LAMBDA (NEW:INFO FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS GET:NEW:INFORMATION BEING:STACK))
(PUSH:DEMONS (TUPLE SPECIFICITY:CHECK:DEMON))
(SATISFY (VECTOR AWARE USER (APPEND (QUOTE (VECTOR PUP WANTS))
(CDAR PUP:WANTS:LIST))))
(PUPRIN1 "
USER: ")
(PUT GET:NEW:INFORMATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG1 (COND
((ATOM NEW:INFO)
(SET NEW:INFO (INVECTOR (PREAD))))
(T (SET (EVAL NEW:INFO)
(INVECTOR (PREAD)))))
(SETQ NEW:INFO:LIST (CONS (EVAL NEW:INFO)
NEW:INFO:LIST))
(SETQ PUP:WANTED:LIST (CONS (CAR PUP:WANTS:LIST)
PUP:WANTED:LIST))
(SETQ PUP:WANTS:LIST (CDR PUP:WANTS:LIST))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK))
(POP:DEMONS))))
(IS:OF:TYPE
(LAMBDA (OBJECT SPECIAL:KNOWLEDGE FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS IS:OF:TYPE BEING:STACK))
(MATCH (TUPLE COMMENT FRAG1)
SPECIAL:KNOWLEDGE)
(PUT IS:OF:TYPE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (ASK:USER:ABOUT OBJECT)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(JOINING:FUNCTION
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS JOINING:FUNCTION BEING:STACK))
(PUT JOINING:FUNCTION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (COMMENT DEPENDS UPON THE SPECIFIC FLAVOR
OF JOINING REQUIRED. USUSALLY AND, OR, XOR, SERIES, ... ETC.))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(LIST:STRUCTURE
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS LIST:STRUCTURE BEING:STACK))
(PUT LIST:STRUCTURE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (STRUCTURE (CAR ATOM FRONT OF LIST:STRUCTURE)
(CDR LIST ALL BUT THE FRONT OF THE LIST:STRUCTURE)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(MAKE:A:GUESS
(LAMBDA (POSS:OBJ FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS MAKE:A:GUESS BEING:STACK))
(PUT MAKE:A:GUESS SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (PUPRIN1 " BY GUESS I ASSUME YOU ARE REFERRING TO ")
(PUPRIN1 POSS:OBJ)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(MAKE:ENCODABLE
(LAMBDA (B:CALL ANY1:HOLD ANY2:HOLD FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS MAKE:ENCODABLE BEING:STACK))
(PUT MAKE:ENCODABLE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (OR (AND (ATOM B:CALL)
(GETP B:CALL ENCODABLE)
(SETQ TYPE:OF:LIST (CONS (VECTOR (@ B:CALL)
TYPE OF (CAR (GETP B:CALL GENERALIZATIONS))
IS
(INVECTOR (GETP B:CALL META:CODE)))
TYPE:OF:LIST)))
(AND (MATCH (VECTOR ANY1 TYPE OF ANY2 FRAG1)
B:CALL)
(SETQ ANY1:HOLD ANY1)
(SETQ ANY2:HOLD ANY2)
(COND
((MAKE:ENCODABLE ANY1))
((GETP ANY2:HOLD ENCODABLE)
(SETQ TYPE:OF:LIST (CONS (VECTOR (@ ANY1:HOLD)
TYPE OF (@ ANY2:HOLD)
IS
(INVECTOR (GETP ANY2:HOLD
META:CODE))))))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(MAKE:NEW:BEING
(LAMBDA (FNAME YY TARGS BARGS FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS MAKE:NEW:BEING BEING:STACK))
(PUT MAKE:NEW:BEING SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SET FNAME FNAME)
(SET (PACK (LIST FNAME TOTAL))
0)
(SETQ YY WRITE:PROGRAM)
(SETQ IS:BEING:LIST (CONS FNAME IS:BEING:LIST))
(SETQ TARGS (COND
(FARGS (SETINTERSECTION FARGS FARGS))
((GETP BNAME EXPLICIT:ARGS))))
(SETQ BARGS (FIRSTN (LENGTH FARGS)
(GETP BNAME EXPLICIT:ARGS)))
(MAPC SET:OF:BEING:PARTS (FUNCTION (LAMBDA (BP)
(COND
((GETP BNAME BP)
(PUT FNAME BP (COND
(BARGS (SUBPAIR BARGS TARGS (COPY (GETP BNAME BP))
T))
(T (GETP BNAME BP)))))))))
(PUT FNAME BEING T)
(PUT FNAME IDEN (SUBST FNAME BNAME (MAPCAR (GETP FNAME IDEN)
(FUNCTION (LAMBDA (ID)
(CONS (LIST Z@
(LIST Z@ (CAR ID)))
(CDR ID)))))))
(COND
((GETP BNAME ENCODABLE)
(PUT FNAME COMMENTS (MAPC (GETP BNAME COMMENTS)
(QUOTE EVAL)))))
(ADD:IDEN FNAME)
(PUT FNAME MAIN:EFFECTS (SUBST FNAME BNAME (COPY (GETP FNAME MAIN:EFFECTS))))
(ADD:EFFECTS FNAME)
(PUT FNAME EXPLICIT:ARGS TARGS)
(PUT FNAME WHAT (VECTOR A SPECIALIZED BEING WHICH DOES (GETP FNAME WHAT)))
(PUT FNAME WHY (APPEND (GETP FNAME WHY)
(TUPLE AND (@ BNAME)
IS TOO GENERAL
TO USE AS IT IS)))
(PUT FNAME META:CODE (COND
((LESSP (LENGTH CODE)
2)
(CAR CODE))
((NOT (LISTP (CAR CODE)))
CODE)
(T (CONS (QUOTE PROGN)
CODE))))
(COND
((LISTP (GETP FNAME EXPLICIT:ARGS:CHECK))
(PUPRIN1 (CONCAT "
IS " (GETP FNAME EXPLICIT:ARGS:CHECK)
" STILL THE PROPER EXPLICIT
ARGS CHECK FOR THE FUNCTION " FNAME "? (I DON'T THINK IT IS!!)
USER: "))
(COND
((NOT (MEMBER (PREAD)
(TUPLE Y YES)))
(PUPRIN1 "
WHAT IS THE CHECK, THEN? (I SUGGEST 'T')
USER: ")
(PUT FNAME EXPLICIT:ARGS:CHECK (OUTVECTOR (LIST:TRANSLATE
(INVECTOR (PREAD))
T)))))))
(PUT FNAME GENERALIZATIONS (CONS BNAME (GETP FNAME GENERALIZATIONS)))
(PUT FNAME AFFECTS (PROG (X)
(SETQ X (VECTOR))
(MAPC (FLATTEN CODE)
(FUNCTION (LAMBDA (CC)
(COND
((GETP (CAR (COLON:BREAK CC))
BEING)
(SETQ X (NCONC1 X (VECTOR (@ CC)
POSSIBLE CALLED))
)
(SETQ YY (CONS CC YY)))))))
(RETURN X)))
(PUT FNAME SPECIALIZATIONS NIL)
(PUT FNAME COMPLEXITY:VECTOR (VECTOR:AVERAGE YY))
(SEMI:COMPILE FNAME)
T))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(MESSAGE
(LAMBDA (M FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS MESSAGE BEING:STACK))
(PUT MESSAGE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (TERPRI)
(PUPRIN1 "PUP: ")
(PUPRINT (OUTVECTOR M))
(TERPRI)
(SETQ AWARE:USER:LIST (CONS M AWARE:USER:LIST))
(SETQ FRINGE:CONCIOUS:LIST (LIST M (CAR FRINGE:CONCIOUS:LIST)))
(SETQ LASTRESPONDER (QUOTE PUP))
(SETQ READ:USER:LIST (CONS M READ:USER:LIST))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(METRICAL:CONCEPT:FORMATION
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS METRICAL:CONCEPT:FORMATION BEING:STACK))
NIL
(PUT METRICAL:CONCEPT:FORMATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (PARTITION:A:DOMAIN)
(ORDER PARTITION)
(METRIZE ORDER)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(MODIFY:STRUCTURE
(LAMBDA (S ARG2 FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS MODIFY:STRUCTURE BEING:STACK))
(PUT MODIFY:STRUCTURE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (VECTOR THIS DEPENDS ON WHAT THE USER WANTS DONE TO THE STRUCTURE))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(OBTAIN:USABLE:INFORMATION
(LAMBDA (U FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS OBTAIN:USABLE:INFORMATION BEING:STACK))
(PUT OBTAIN:USABLE:INFORMATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN (SETQ BECAUSE
(QUOTE (VECTOR WE CAN ONLY TRY TO OBTAIN USABLE INFORMATION IN ONE WAY AT A TIME)))
(CHOOSE:FROM (QUOTE ((TRANSLATE U)
(GET:NEW:INFORMATION U)
(ANALYZE:IMPLICATIONS U)
(EXTRACT:RELEVANT:SUBSET U))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PARTITION:A:DOMAIN
(LAMBDA (PRESULT FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PARTITION:A:DOMAIN BEING:STACK))
(PUSH:DEMONS (TUPLE FRINGE:OF:CONCIOUSNESS:DEMON))
(PUT PARTITION:A:DOMAIN SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN (COMMENT WE SHOULD NEVER REALLY BE HERE, SINCE THIS IS ALWAYS DONE
BY A COLLECTION OF THE THREE METHODS OF PARTITIONING DISCUSSED IN THE 'SPECIALIZATIONS'
SECTION)
(SETQ PARTITIONED:DOMAIN:LIST T)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK))
(POP:DEMONS))))
(PARTITION:BY:TAKE:CLASS:GET:ELE
(LAMBDA (PRESULT FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PARTITION:BY:TAKE:CLASS:GET:ELE BEING:STACK))
(PUT PARTITION:BY:TAKE:CLASS:GET:ELE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (TAKE:HOLD:OF NAME:OF:CLASS)
(SETQ PRESULT (GET:HOLD:OF ELEMENT))
(TAKE:HOLD:OF ELEMENT)
(COMPLEX:MODIFY:STRUCTURE NAME:OF:CLASS ELEMENT PRESULT)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PARTITION:BY:TAKE:ELE:AND:CLASS
(LAMBDA (PRESULT FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PARTITION:BY:TAKE:ELE:AND:CLASS BEING:STACK))
(PUT PARTITION:BY:TAKE:ELE:AND:CLASS SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (TAKE:HOLD:OF ELEMENT)
(TAKE:HOLD:OF NAME:OF:CLASS)
(MODIFY:STRUCTURE NAME:OF:CLASS)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PARTITION:BY:TAKE:ELE:GET:CLASS
(LAMBDA (PRESULT FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PARTITION:BY:TAKE:ELE:GET:CLASS BEING:STACK))
(PUT PARTITION:BY:TAKE:ELE:GET:CLASS SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (TAKE:HOLD:OF ELEMENT)
(GET:HOLD:OF NAME:OF:CLASS)
(MODIFY:STRUCTURE NAME:OF:CLASS)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PATTERN:MATCH
(LAMBDA (PAT EXP FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PATTERN:MATCH BEING:STACK))
(PUT PATTERN:MATCH SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (MATCH PAT EXP))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PROBABILITY=0:#
(LAMBDA (OBJECT WORLD FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PROBABILITY=0:# BEING:STACK))
(PUT PROBABILITY=0:# SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN (COMMENT SINCE ARG1 SHOULD NEVER OCCUR, WE HAVE A CONTRADICTION
IF IT IS A MEMBER OF ARG2)
(MEMBER ARG1 ARG2)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PROBABILITY=1:#
(LAMBDA (OBJECT WORLD FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PROBABILITY=1:# BEING:STACK))
(PUT PROBABILITY=1:# SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN (COMMENT ARG1 OCCURS WITH PROBABILITY 1, SO IT HAD BETTER BE
IN ARG2, THE RELEVANT PIECE OF THE WORLD)
(NOT (MEMBER ARG1 ARG2))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PROBABILITY>0&<1:#
(LAMBDA (OBJECT WORLD FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PROBABILITY>0&<1:# BEING:STACK))
(PUT PROBABILITY>0&<1:# SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
(PROGN (COMMENT WE MAY OR MAY NOT HAVE ARG1 IN ARG2; EITHER CASE IS ALLOWABLE; SO WE
NEVER HAVE A CONTRADICTION)
NIL))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(PROPOSE:PLAUSIBLE:NAMES
(LAMBDA (EXPRES EXPRES2 NEW:EXPRES MSG FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS PROPOSE:PLAUSIBLE:NAMES BEING:STACK))
(PUSH:DEMONS (TUPLE FRINGE:OF:CONCIOUSNESS:DEMON PSYCHOLOGY:DEMON))
(COND
((ATOM EXPRES)
(SETQ NEW:EXPRES (COLON:BREAK EXPRES)))
(T (SETQ NEW:EXPRES (PROG (TEMP1)
(MAPC EXPRES (FUNCTION (LAMBDA (ZZ)
(SETQ TEMP1 (APPEND TEMP1 (COLON:BREAK ZZ))))))
(RETURN TEMP1)))))
(PUT PROPOSE:PLAUSIBLE:NAMES SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG (P)
(SETQ EXPRES2 (OUTVECTOR (OUTQUOTE NEW:EXPRES)))
(SETQ P (MAPCAR (LIST (INITIALS EXPRES2)
(MAIN:WORDS EXPRES2)
(FIRST:FEW (INITIALS EXPRES2))
(FIRST:FEW (INITIALS (MAIN:WORDS EXPRES2)))
(LIST (PACK (INITIALS EXPRES2)))
(LIST (PACK (FIRST:FEW (INITIALS EXPRES2)))))
(QUOTE COLON:BACK)))
(SETQ P (SETDIFFERENCE P KNOWN:NAMES))
(SETQ P (INTERSECTION P P))
(SETQ MSG (VECTOR (@ P)
IS THE SET OF PLAUSIBLE NAMES OF (@ EXPRES2)
WHICH IS AN EXPANSION
OF (@ EXPRES)))
(SETQ PLAUSIBLE:NAMES:LIST (CONS (VECTOR FOR (@ EXPRES)
HAVE BEEN STUDIED)
PLAUSIBLE:NAMES:LIST))
(SETQ PUP:STUDIED:LIST (CONS (VECTOR PLAUSIBLE NAMES FOR (@ EXPRES))
PUP:STUDIED:LIST))
(RETURN P)))
(SATISFY (VECTOR AWARE USER (INVECTOR MSG)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK))
(POP:DEMONS))))
(REINVESTIGATE:DECISION
(LAMBDA (D D1 FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS REINVESTIGATE:DECISION BEING:STACK))
(OR (MEMBER D DEFERRED:DECISION:LIST)
(EQUAL (CADDDR D)
(VECTOR BECAUSE OF DIRECT COMMAND)))
(PUT REINVESTIGATE:DECISION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR USER:INTERRUPT:DEMONS (QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ DEFERRED:DECISION:LIST (PULLOUT D DEFERRED:DECISION:LIST))
(SETQ UNDEFERRED:DECISION:LIST (CONS (CADR D)
UNDEFERRED:DECISION:LIST))
(DEFER:DECISION (CADR D))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(REPEATEDLY
(LAMBDA (ACT1 ACT2 ACT3 ACT4 F1 FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS REPEATEDLY BEING:STACK))
(PUT REPEATEDLY SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (VECTOR SEE THE FORM:CHANGING SECTION)
(SETQ F1 (APPEND (TUPLE REPEATEDLY)
ACT1 ACT2 ACT3 ACT4))
(EVAL (GETP REPEATEDLY FORM:CHANGING))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(RESOLVE:DECISION
(LAMBDA (D STAG D1 ENT2 ENT1 TRESULT NEWPIECE FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS RESOLVE:DECISION BEING:STACK))
(PUT RESOLVE:DECISION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR USER:INTERRUPT:DEMONS (QUOTE APPLY*))))
(SETQ FN:VALUE (COND
((MEMBER (CADR D)
RESOLVED:DECISION:LIST)
T)
(T (SETQ RESOLVED:DECISION:LIST (CONS (VECTOR (CADR D)
IS RESOLVED AS (INVECTOR (ASK:USER:ABOUT D)))
RESOLVED:DECISION:LIST)))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(SATISFY
(LAMBDA (G FORCE:SAT TEMP:LIST EV:G FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS SATISFY BEING:STACK))
(SETQ G (EVAL G))
(SETQ EV:G (EVAL (CADDDR G)))
(PUT SATISFY SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR USER:INTERRUPT:DEMONS (QUOTE APPLY*))))
(SETQ FN:VALUE (COND
((AND (MEMBER EV:G (FIRSTN 90 (EVAL (SETQ TEMP:LIST (COLON:BACK (COPY (LIST (CADR G)
(CADDR G)
(QUOTE LIST))))))))
(NOT FORCE:SAT)))
(T (SOME EFFECTS:TABLE (FUNCTION (LAMBDA (E1)
(AND (MATCH (CAR E1)
G)
(EVAL (CDR (EVAL (CADR E1))))))))
(SETQ BECAUSE (VECTOR WE CALL THE FIRST BEING WHICH CAN BRING ABOUT THE EFFECT (@ G)))
(COND
((MEMBER EV:G (EVAL TEMP:LIST))
(SETQ PUP:SATISFIED:LIST (CONS G PUP:SATISFIED:LIST)))
((MEMBER G USER:WARNING:LIST)
NIL)
(T (PUPRIN1 "
PUP: I AM MUMBLING TO MYSELF ABOUT SATISFYING ")
(PUPRIN1 G)
(SETQ USER:WARNING:LIST (CONS G USER:WARNING:LIST))
NIL)))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(SCENE
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS SCENE BEING:STACK))
NIL
(PUT SCENE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (STRUCTURE (OBJECTS SET O)
(CLASS:NAME NAME N)
(STATIC RELATIONS S BETWEEN OBJECTS)
(DYNAMIC RELATIONS D BETWEEN OBJECTS)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(SEARCH
(LAMBDA (GOAL SPACE X XSET FN:VALUE FINAL:CO:REQ)
(PROG1
(AND
(SETQ BEING:STACK (CONS SEARCH BEING:STACK))
SPACE
(PROGN (DETERMINE:ARG:VALUE CHOICE)
(SETQ X (COND
((EQUAL POSSIBLE (CAR (COLON:BREAK ARG1)))
ARG1)
((COLON:BACK (LIST POSSIBLE ARG1)))))
(SETQ XSET (COLON:BACK (LIST SET:OF (PLURAL X)))))
(PUT SEARCH SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE
($
(COND
((OR (SETQ SH NIL)
(PROGN (SATISFY (VECTOR IS CONSTRAINED (SET XSET XSET)))
(NOT (SETQ CL (CADR (SASSOC XSET IS:CONSTRAINED:LIST)))))
(GREATERP (LENGTH CL)
2)
(COND
((SETQ SH (SOME RESULT:BINDING:LIST (FUNCTION (LAMBDA (RB)
(MATCH (VECTOR (@ XSET)
SEARCH PREDICATE IS ANY1)
RB)))))
NIL)
(T (PUPRIN1 (CONCAT "
DOES THERE EXIST A PREDICATE WHICH IS TRUE PRECISELY WHEN AN ELEMENT
IS " (CAR CL)
" AND IS NIL IFF THE ELEMENT IS "
(CADR CL)
"?
USER: (YES OR NO, FOR NOW......) "))
(MEMBER (PREAD)
(TUPLE N NO NIL)))))
(INSTANTIATE (QUOTE (PROGN (FOREACH ($ X) IN ($ XSET)
DO ($ (TUPLE TEST (@ X)
(COMMENT FOR SATISFACTION OF GOAL CRITERIA))))
(PUPRIN1 "
MY GUESS FOR THIS IS ")
(PUPRINT ($ X))))))
(T (COND
(SH (SETQ CP (CAR (LAST (CAR SH)))))
(T (PUPRIN1 (CONCAT "
OK. NOW GIVE ME THIS PREDICATE, IN TERMS OF " (MOST:GENERAL NEW:THING:LIST)
"
I SUGGEST THAT THIS INVOLVES ONE OF THESE: " PROBABLE:TESTS:LIST "
USER: "))
(SETQ CP (TRANSLATE (INVECTOR (PREAD))
T))
(SETQ RESULT:BINDING:LIST (NCONC1 RESULT:BINDING:LIST (VECTOR (@ XSET)
SEARCH PREDICATE IS (@ CP))))
(SETQ GLOBAL:INITIALIZATION:LIST (APPEND GLOBAL:INITIALIZATION:LIST
(MAPCAR CL (FUNCTION (LAMBDA (CLE)
(LIST (QUOTE SETQQ)
CLE CLE))))))))
(TUPLE PROGN (LIST (QUOTE SETQ)
X
(TUPLE COND (LIST (OUTVECTOR CP)
(CAR CL))
(LIST T (CADR CL))))
(TUPLE PUPRIN1 "
MY GUESS FOR THIS IS ")
(TUPLE PUPRINT (@ X)))))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(SERVE
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS SERVE BEING:STACK))
(PUSH:DEMONS (TUPLE FORGETFUL:USER:DEMON))
(SATISFY (VECTOR AWARE USER (VECTOR PUP WANTS ANY TASK)))
(SETQ PUP:WANTS:LIST (CONS (VECTOR ANY TASK)
PUP:WANTS:LIST))
(PUT SERVE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG NIL
(SETQ UNKNOWN:TASK NON:EXECUTABLE)
(SETQ BECAUSE (VECTOR THE CURRENT TASK (@ UNKNOWN:TASK)
IS NOT EXECUTABLE AND WE HAVE NOTHING
ELSE TO DO AT THE PRESENT TIME))
LABEL6
(COND
((NOT (MEMBER UNKNOWN:TASK EXECUTABLE:INFO:LIST))
(MAPC USER:INTERRUPT:DEMONS (QUOTE APPLY*))
(OBTAIN:USABLE:INFORMATION (QUOTE UNKNOWN:TASK))
(GO LABEL6)))
(SETQ ATTEMPTING:SOMETHING:LIST (CONS UNKNOWN:TASK ATTEMPTING:SOMETHING:LIST))
(SETQ ATTEMPTING:ANYTHING:LIST (CONS UNKNOWN:TASK ATTEMPTING:ANYTHING:LIST))
(SETQ BECAUSE (VECTOR WE FINALLY HAVE AN EXECUTABLE TO TASK TO DO, NAMELY
(@ UNKNOWN:TASK)))
(SETQ EXECUTABLE:INFO:LIST NIL)
(EVAL (CDR UNKNOWN:TASK))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK))
(POP:DEMONS))))
(SIMPLE:COMPARE:FN
(LAMBDA (FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS SIMPLE:COMPARE:FN BEING:STACK))
(PUT SIMPLE:COMPARE:FN SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (ASK:USER:ABOUT VALUE)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(STUDY:TYPE
(LAMBDA (B:CALL FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS STUDY:TYPE BEING:STACK))
(OR (GETP (CADR B:CALL)
BEING)
(PUPRINT (COMMENT (CADR B:CALL)
IS NOT A BEING YET)))
(PUT STUDY:TYPE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (MAPC (CDR (GETP (CADR B:CALL)
SPECIALIZATIONS))
(FUNCTION (LAMBDA (A)
(SETQ UNDEFERRED:DECISION:LIST (NCONC1 UNDEFERRED:DECISION:LIST
(COND
((ATOM A)
A)
((ATOM (CAR A))
(EVAL A))
((APPLY* (EVAL (CAR A))
B:CALL))))))))
(SETQ PUP:STUDIED:LIST (CONS (VECTOR TYPE OF (@ B:CALL))
PUP:STUDIED:LIST))
(SETQ TYPE:OF:LIST (CONS (VECTOR (@ B:CALL)
HAS BEEN STUDIED)
TYPE:OF:LIST))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(SUPPORT&DUMP
(LAMBDA (F OP FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS SUPPORT&DUMP BEING:STACK))
(AND (MEMBER F IS:BEING:LIST))
(PUT SUPPORT&DUMP SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SET (PACK (LIST (CAR (COLON:BREAK F))
(QUOTE FNS)))
(LIST START))
(SET (PACK (LIST (CAR (COLON:BREAK F))
(QUOTE COMS)))
(TUPLE (TUPLE FNS *(PACK (LIST (CAR (COLON:BREAK F))
(QUOTE FNS))))
SET:OF:BEINGS IS:BEING:LIST ASSERT:LISTS GLOBAL:INITIALIZATION:LIST
OLD:PREADLIST SB EXPERTAG YESNO:TAG TASK:TYPE ARG1 ARG2
(QUOTE (COMS *(LIST (APPEND (QUOTE (PROP ALL))
(REVERSE (SETDIFFERENCE IS:BEING:LIST SB))
))))
(TUPLE P (QUOTE (MAPC (SETDIFFERENCE IS:BEING:LIST SB)
(FUNCTION (LAMBDA (B)
(SET B B)
(SEMI:COMPILE B)))))
(QUOTE (MAPC GLOBAL:INITIALIZATION:LIST (QUOTE EVAL)))
(TUPLE PRINT (COMMENT TO AUTOMATICALLY ENTER THE FUNCTION
(@ F)
,JUST TYPE
IN A CALL
TO THE FUNCTION ENTER. THIS WILL INITIALIZE
THE ENTIRE BEINGS SYSTEM AND
THEN CALL (@ F))))))
(COND
((EQUAL (CAR (QUOTE DIALOG))
(QUOTE NOBIND))
(PRIN1 "
WHAT IS 'DIALOG' (WILL BE EVALLED) ? ")
(SETQ DIALOG (EVAL (READ)))))
(SETQ GLOBAL:INITIALIZATION:LIST
(APPEND GLOBAL:INITIALIZATION:LIST (MAPCONC IS:CONSTRAINED:LIST
(FUNCTION (LAMBDA (IC)
(COND
((LISTP IC)
(LIST (TUPLE SETQQ
(CAR IC)
(CADR IC)))))))
)))
(SETQ GLOBAL:INITIALIZATION:LIST (MAPCONC GLOBAL:INITIALIZATION:LIST
(FUNCTION (LAMBDA (GL)
(COND
((CADR GL)
(LIST GL)))))))
(MAPC GLOBAL:INITIALIZATION:LIST (QUOTE EVAL))
(LOADFNS (LIST START)
(QUOTE PUP6)
T)
(PUTD START (COPY (SUBST (LIST F)
(TUPLE SERVE)
(COPY (GETD START)))))
(MAPC (SETDIFFERENCE IS:BEING:LIST SET:OF:BEINGS)
(FUNCTION (LAMBDA (B)
(PUT B META:CODE (CHECK:COMMENTS (GETP B META:CODE))))))
(SETQ OP OLD:PREADLIST)
(SETQ SB SET:OF:BEINGS)
(SETQ GLOBAL:INITIALIZATION:LIST (INTERSECTION GLOBAL:INITIALIZATION:LIST
GLOBAL:INITIALIZATION:LIST))
(SETQ SET:OF:BEINGS IS:BEING:LIST)
(SETQ ASSERT:LISTS (PULLOUT1 (QUOTE GLOBAL:INITIALIZATION:LIST)
ASSERT:LISTS))
(MAPC (SETDIFFERENCE IS:BEING:LIST SB)
SEMI:COMPILE)
(COND
((PERMIT:USER:INTERRUPT)
(SETQ OLD:PREADLIST (CONS (CAR OLD:PREADLIST)
DIALOG))
(SETQ EXPERTAG NIL)
(MAKEFILE (CAR (COLON:BREAK F)))))
(SETQ OLD:PREADLIST OP)
(SETQ SET:OF:BEINGS SB)
(SETQ ASSERT:LISTS (CONS (QUOTE GLOBAL:INITIALIZATION:LIST)
ASSERT:LISTS))
(PUTD START (COPY (SUBST (TUPLE SERVE)
(LIST F)
(COPY (GETD START)))))))
(SATISFY (VECTOR AWARE USER (VECTOR FILE (CAR (COLON:BREAK F))
HAS BEEN MADE AND WILL SUPPORT BEING (@ F))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(TRANSLATE
(LAMBDA (NEW:INFO FORCE:TRANSLATE EV:NEW:INFO PART1 PART2 FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS TRANSLATE BEING:STACK))
(PUSH:DEMONS (TUPLE IDIOM:DEMON))
(OR (MEMBER (EVAL NEW:INFO)
NEW:INFO:LIST)
(NULL (EVAL NEW:INFO))
FORCE:TRANSLATE
(COND
(NEW:INFO:LIST (SETQQ NEW:INFO UNKNOWN:TASK)
(SET NEW:INFO (CAR NEW:INFO:LIST)))))
(SETQ EV:NEW:INFO (EVAL NEW:INFO))
(PUT TRANSLATE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG (LI TEMPTR)
(SETQ LI (CDR EV:NEW:INFO))
(SETQ NEW:INFO:LIST (PULLOUT EV:NEW:INFO NEW:INFO:LIST))
(COND
((SOME IDEN:TABLE (FUNCTION (LAMBDA (II)
(COND
((EVAL (CAR II))
(COND
((SETQ TEMPTR (EVAL (CADR II)))
(SETQ TRANSLATED:PAIR:LIST (CONS (LIST EV:NEW:INFO TEMPTR)
TRANSLATED:PAIR:LIST))
(SETQ TRANSLATED:INFO:LIST (CONS EV:NEW:INFO
TRANSLATED:INFO:LIST))
(COND
((NOT FORCE:TRANSLATE)
(SETQ EXECUTABLE:INFO:LIST (CONS TEMPTR
EXECUTABLE:INFO:LIST)))))
)
T)))))
(RETURN TEMPTR)))
(PUPRIN1 "SORRY, I T TRANSLATE
PLEA
PLEA")
(PUPRIN1 "
PLEASE RETYPE THE FOLLOWING, REPHRASING IT SO I CAN COMPREHEND IT:
")
(PUPRIN1 EV:NEW:INFO)
(RETURN (TRANSLATE (INVECTOR (PREAD))
T))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK))
(POP:DEMONS))))
(USE:INFORMATION
(LAMBDA (PROGRAM ACTION FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS USE:INFORMATION BEING:STACK))
EXECUTABLE:INFO:LIST
(PUT USE:INFORMATION SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ ACTION (COND
((GETP (CAR (OUTVECTOR (CAR EXECUTABLE:INFO:LIST)))
NON:EVAL:ARGS)
(COND
((EQUAL (CAAR EXECUTABLE:INFO:LIST)
VECTOR)
(CDAR EXECUTABLE:INFO:LIST))
(T (CAR EXECUTABLE:INFO:LIST))))
(T (OUTVECTOR (CAR EXECUTABLE:INFO:LIST)))))
(SETQ EXECUTABLE:INFO:LIST (CDR EXECUTABLE:INFO:LIST))
(COND
((EVAL ACTION))
(T (NCONC1 EXECUTABLE:INFO:LIST ACTION)
NIL))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(UTILIZE
(LAMBDA (KNOW:NAME APLIED:SO:AS:TO:KEEP INVARIANT KNOW:LIST DEC FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS UTILIZE BEING:STACK))
(AND (EQUAL (CAR INVARIANT)
VECTOR)
(MEMBER (CADR INVARIANT)
(QUOTE (RELEVANT IRRELEVANT)))
(ATOM KNOW:NAME)
(OR (NULL (EVAL KNOW:NAME))
(LISTP (EVAL KNOW:NAME))))
(OR (SETQ KNOW:LIST (EVAL KNOW:NAME))
T)
(PUT UTILIZE SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG (AF HOLD:ANY2 KRETURN)
(COND
((MATCH (VECTOR ANY2 (VECTOR PUP REINVESTIGATE FRAG1))
INVARIANT)
(SETQ HOLD:ANY2 ANY2)
(SETQ DEC (CONS VECTOR FRAG1))
(SETQ AF (CADR (MEMBER WHEN DEC)))
(SOME (EVAL (COLON:BACK (CONS WHEN:ALL (CDR (COLON:BREAK KNOW:NAME)))))
(FUNCTION (LAMBDA (K)
(COND
((MATCH (CAR K)
AF)
(SETQ KRETURN (EVAL (CADR K)))
T)))))
(COND
(KRETURN (RETURN KRETURN)))
(SETQ AF (CADR (MEMBER AFFECTS DEC)))
(SOME (EVAL (COLON:BACK (CONS AFFECTS:ALL (CDR (COLON:BREAK KNOW:NAME)))))
(FUNCTION (LAMBDA (K)
(COND
((MATCH (CAR K)
AF)
(SETQ KRETURN (EVAL (CADR K))))))))
(COND
(KRETURN (RETURN KRETURN)))
(SOME KNOW:LIST (FUNCTION (LAMBDA (K)
(COND
((SETQ AF (EVAL K))
(SETQ KRETURN (VECTOR (OPPOSITE HOLD:ANY2)
(@ AF))))))))
(COND
(KRETURN (RETURN KRETURN)))
(RETURN NIL))
(T (RETURN NIL)))))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(WHEN:NEXT
(LAMBDA (ACT UTILIZATION UTIL2 AWARE:LIST FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS WHEN:NEXT BEING:STACK))
(AND (MEMBER (CADR ACT)
(QUOTE (USER PUP)))
(EQUAL (LENGTH ACT)
4))
(PUT WHEN:NEXT SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROGN (SETQ RELEVANT:KNOWLEDGE (COLON:BACK (COPY (TUPLE (CADR (CADDDR ACT))
(CADR BEING:STACK)
KNOWLEDGE))))
(SETQ UTILIZATION (VECTOR DELAYABLE (@ ACT)
UNTIL (SETQ UTIL2 (UTILIZE
RELEVANT:KNOWLEDGE APPLIED:SO:AS:TO:KEEP
(VECTOR IRRELEVANT (APPEND (VECTOR (CADR ACT)
(CADDR ACT))
(CDDAR (CDDDR ACT)))))))
)
(SETQ AWARE:LIST (COLON:BACK (COPY (LIST (QUOTE AWARE)
(CADR ACT)
(QUOTE LIST)))))
(SET AWARE:LIST (CONS UTILIZATION (EVAL AWARE:LIST)))
UTIL2))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK)))))
(WRITE:PROGRAM
(LAMBDA (TASK TASK:TYPE TASK:NAME FARGS FN:VALUE FINAL:CO:REQ)
(PROG1 (AND (SETQ BEING:STACK (CONS WRITE:PROGRAM BEING:STACK))
(PUSH:DEMONS (TUPLE PROGRAM:WRITING:DEMONS DEFERRAL:DEMON REINVESTIGATION:DEMON))
(SATISFY (VECTOR AWARE USER (VECTOR PUP IS ABOUT TO WRITE A PROGRAM TO DO (@ TASK))))
(SATISFY (VECTOR NAMED EXPRESSION (@ TASK)
(VECTOR TASK:NAME)))
(SATISFY (VECTOR AWARE USER (VECTOR THE NAME OF THE PROGRAM TO DO (@ TASK)
IS
(@ TASK:NAME))))
(SATISFY (VECTOR TYPE OF (VECTOR (@ TASK)
HAS BEEN STUDIED)))
(PUT WRITE:PROGRAM SPEC:WHY BECAUSE)
(NOT (MEMBER NIL (MAPCAR (APPEND CURRENT:DEMONS USER:INTERRUPT:DEMONS)
(QUOTE APPLY*))))
(SETQ FN:VALUE (PROG (DONE PGM)
(SETQ PGM (VECTOR))
(SETQ UNDEFINED:SECTION:LIST (CONS (VECTOR (@ TASK:NAME)
TYPE OF (@ TASK))
UNDEFINED:SECTION:LIST))
LABEL4
(ECONOMY:DEMON)
(COND
((AND (GETP TASK:NAME BEING)
(NULL CODING:WARNING:LIST)
(NULL EXECUTABLE:INFO:LIST)
(NULL NEW:INFO:LIST)
(NULL UNDEFINED:SECTION:LIST))
(PUPRIN1 " NEAR END OF TASK -- ")
(PERMIT:USER:INTERRUPT)
(COND
(DEFERRED:DECISION:LIST (SETQ DOING:PUP:LIST (CONS (VECTOR DETAIL
OF OUTPUTING)
DOING:PUP:LIST))
(SETQ CHOICE NIL)
(REINVESTIGATION:DEMON)))
(SETQ WRITTEN:PROGRAMS:LIST (CONS TASK WRITTEN:PROGRAMS:LIST))
(SETQ ABLE:PUP:LIST (CONS TASK ABLE:PUP:LIST))
(SETQ ABLE:USER:LIST (CONS TASK ABLE:USER:LIST))
(INTERSECTION GLOBAL:INITIALIZATION:LIST GLOBAL:INITIALIZATION:LIST)
(SUPPORT&DUMP TASK:NAME)
(RETURN T))
((NOT (MEMBER NIL (MAPCAR (APPEND USER:INTERRUPT:DEMONS CURRENT:DEMONS)
(QUOTE APPLY*))))
(CHOOSE:FROM (QUOTE ((OBTAIN:USABLE:INFORMATION (QUOTE PGM))
(USE:INFORMATION (QUOTE PGM))
(FILL:IN:UNDEFINED:SECTION (QUOTE PGM))
(CLARIFY:IMPROBABLE:SITUATION (QUOTE PGM))
(ADAPT:PRECONCEIVED:FUNCTION (QUOTE PGM))
(FIX:INCORRECT:PIECE (QUOTE PGM)))))
(GO LABEL4))
(T (RETURN NIL)))))
(SATISFY (VECTOR AWARE USER (VECTOR THE PROGRAM (@ TASK:NAME) TO DO (@ TASK)
IS COMPLETE)))
FN:VALUE)
(SETQ BEING:STACK (CDR BEING:STACK))
(POP:DEMONS))))
)
(RPAQQ FNSCOMP
(ADD:DEFINITION ADJECTIVE:HANDLER ANALYZE:IMPLICATIONS APPLYRULE ASK:USER:ABOUT BETTER CHOOSE:FROM
CLARIFY:IMPROBABLE:SITUATION CLASSIFICATORY:CONCEPT:FORMATION COMPARE
COMPARITIVE:CONCEPT:FORMATION COMPLEX:ALTERATION CONDITIONAL:DELETION CONDITIONAL:INSERTION
CONSTRAIN DATA:STRUCTURE:DELETIONS DATA:STRUCTURE:INSERTIONS DEFER:DECISION ENCODE
EXAMINE:STRUCTURE EXTRACT:RELEVANT:SUBSET FAST:GET:NAME FAST:SATISFY FILL:IN:UNDEFINED:SECTION
FOREACH GET:DATA:STRUCTURE GET:HOLD:OF GET:NAME GET:NEW:INFORMATION IS:OF:TYPE
JOINING:FUNCTION LIST:STRUCTURE MAKE:A:GUESS MAKE:ENCODABLE MAKE:NEW:BEING MESSAGE
METRICAL:CONCEPT:FORMATION MODIFY:STRUCTURE OBTAIN:USABLE:INFORMATION PARTITION:A:DOMAIN
PARTITION:BY:TAKE:CLASS:GET:ELE PARTITION:BY:TAKE:ELE:AND:CLASS
PARTITION:BY:TAKE:ELE:GET:CLASS PATTERN:MATCH PROBABILITY=0:# PROBABILITY=1:#
PROBABILITY>0&<1:# PROPOSE:PLAUSIBLE:NAMES REINVESTIGATE:DECISION REPEATEDLY RESOLVE:DECISION
SATISFY SCENE SEARCH SERVE SIMPLE:COMPARE:FN STUDY:TYPE SUPPORT&DUMP TRANSLATE USE:INFORMATION
UTILIZE WHEN:NEXT WRITE:PROGRAM))
(MAPC (SETDIFFERENCE SET:OF:BEINGS FNSCOMP)
SEMI:COMPILE)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAML GET:HOLD:OF FOREACH CONSTRAIN)
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (1644 96339 (ADD:DEFINITION 1656 . 2631) (ADJECTIVE:HANDLER 2635 . 3593) (ANALYZE:IMPLICATIONS 3597
. 4206) (APPLYRULE 4210 . 4832) (ASK:USER:ABOUT 4836 . 5932) (BETTER 5936 . 7526) (CHOOSE:FROM 7530 . 9140) (
CLARIFY:IMPROBABLE:SITUATION 9144 . 24045) (CLASSIFICATORY:CONCEPT:FORMATION 24049 . 24476) (COMPARE 24480 . 24884)
(COMPARITIVE:CONCEPT:FORMATION 24888 . 25335) (COMPLEX:ALTERATION 25339 . 25735) (CONDITIONAL:DELETION 25739 . 26123)
(CONDITIONAL:INSERTION 26127 . 26514) (CONSTRAIN 26518 . 27994) (DATA:STRUCTURE:DELETIONS 27998 . 32991) (
DATA:STRUCTURE:INSERTIONS 32995 . 37998) (DEFER:DECISION 38002 . 38872) (ENCODE 38876 . 45828) (EXAMINE:STRUCTURE
45832 . 46525) (EXTRACT:RELEVANT:SUBSET 46529 . 47124) (FAST:GET:NAME 47128 . 50773) (FAST:SATISFY 50777 . 52439)
(FILL:IN:UNDEFINED:SECTION 52443 . 54908) (FOREACH 54912 . 55555) (GET:DATA:STRUCTURE 55559 . 57846) (GET:HOLD:OF
57850 . 58245) (GET:NAME 58249 . 61721) (GET:NEW:INFORMATION 61725 . 62639) (IS:OF:TYPE 62643 . 63086) (JOINING:FUNCTION
63090 . 63544) (LIST:STRUCTURE 63548 . 63991) (MAKE:A:GUESS 63995 . 64426) (MAKE:ENCODABLE 64430 . 65444) (
MAKE:NEW:BEING 65448 . 68579) (MESSAGE 68583 . 69237) (METRICAL:CONCEPT:FORMATION 69241 . 69706) (MODIFY:STRUCTURE
69710 . 70127) (OBTAIN:USABLE:INFORMATION 70131 . 70777) (PARTITION:A:DOMAIN 70781 . 71452) (
PARTITION:BY:TAKE:CLASS:GET:ELE 71456 . 72039) (PARTITION:BY:TAKE:ELE:AND:CLASS 72043 . 72554) (
PARTITION:BY:TAKE:ELE:GET:CLASS 72558 . 73068) (PATTERN:MATCH 73072 . 73430) (PROBABILITY=0:# 73434 . 73928) (
PROBABILITY=1:# 73932 . 74439) (PROBABILITY>0&<1:# 74443 . 74941) (PROPOSE:PLAUSIBLE:NAMES 74945 . 76625) (
REINVESTIGATE:DECISION 76629 . 77281) (REPEATEDLY 77285 . 77813) (RESOLVE:DECISION 77817 . 78398) (SATISFY 78402 .
79509) (SCENE 79513 . 79977) (SEARCH 79981 . 82283) (SERVE 82287 . 83605) (SIMPLE:COMPARE:FN 83609 . 83986) (STUDY:TYPE
83990 . 85012) (SUPPORT&DUMP 85016 . 88508) (TRANSLATE 88512 . 90141) (USE:INFORMATION 90145 . 91019) (UTILIZE 91023
. 92798) (WHEN:NEXT 92802 . 93879) (WRITE:PROGRAM 93883 . 96336)))))
STOP